perm filename GEOMED.FAI[GEM,BGB]4 blob
sn#102652 filedate 1974-05-24 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00044 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE GEOMED - GEOMETRIC EDITOR - BRUCE G. BAUMGART - MARCH 1974.
C00009 00003 EDITOR STATUS.
C00012 00004 SUBN(GEONIT) GEOMETRIC EDITOR INITIALIZATION.
C00014 00005 ASCII 00 TO 37--------------------------------------------------
C00017 00006 ASCII 40 TO 100-------------------------------------------------
C00020 00007 ASCII 101 TO 132 UPPER CASE-------------------------------------
C00024 00008 VBODY: MAKE VERTEX BODY.
C00026 00009 MIDPOI: "M" MIDPOINT AN EDGE PROPORTIONAL TO DDEL.
C00028 00010 XSWEEP:
C00030 00011 XKILL: "K"
C00032 00012 EUTRAN: Apply a Euclidean transformation to an object.
C00034 00013 ----- EUTRAN
C00036 00014
C00039 00015 SUBN(GEOFRM) MAKE CURRENT GEOMED FRAME OF REFERENCE.
C00043 00016 SWITCH COMMANDS.
C00047 00017 STACK MODIFYING COMMANDS. "↔↓↑"
C00049 00018 STRENGTH COMMANDS.
C00052 00019 LINKER: LINK FOLLOWING COMANDS.
C00054 00020 ----- LINKER OTHER LINK COMMANDS.
C00057 00021 XNAME: NAME A BODY (OR A WORLD)
C00059 00022 SUBR(RDNAME)
C00061 00023 INSTANT:
C00063 00024 XDPY:
C00064 00025 INPUT OUTPUT COMMANDS.
C00066 00026 W - MAKE WINDOW IN "NOW" DISPLAY RING.
C00068 00027 XCONVEX: FORCE CONVEX FACES.
C00069 00028 EXTEND: "X"-EXTEND COMMANDS.
C00073 00029 XCUBE: MAKE CUBIC PRISM. "X-CUB".
C00075 00030 XNSHARP: MARK ALL EDGES NOT-SHARP.
C00078 00031 XSCROL: SCROLL CAMERA VISIBLE EDGES.
C00080 00032 XCOLOR: COLORING X-COMMAND.
C00083 00033 SUBR(STADPY) STATUS DISPLAY
C00086 00034 ----- STADPY
C00089 00035 ----- STADPY DISPLAY THE SCRATCH PAD PDL.
C00091 00036 SUBR(NTYPE,NODE) FETCH NODE TYPE NUMBER 0 TO 17.
C00093 00037 TABLES REL,CONTYP,NNAMES,NLETTER Node Info. Tables
C00096 00038 NODE CONTENT TYPES.
C00098 00039 SUBR(DPYNODE,NODE) DISPLAY NODE CONTENTS.
C00100 00040 FORMAT-2 DISPLAY GEOMETRIC DATA OF BODY,CAMERA OR SUN.
C00104 00041 FORMAT-1 DISPLAY FULL CONTENTS OF NODE: WORD -3 THRU WORD +8.
C00106 00042 SUBN(BDPY,BODY)
C00109 00043 SUBN(FDPY,FACE) SPECIAL FACE DISPLAY.
C00111 00044 SUBR(IDPY,NODE) IDENTIFIER DISPLAY.
C00115 ENDMK
C⊗;
TITLE GEOMED - GEOMETRIC EDITOR - BRUCE G. BAUMGART - MARCH 1974.
COMMENT /
UBI MATERIA, IBI GEOMETRIA. - KEPLER.
/
;START ADDRESS INITIALIZATION.---------------------------------------
.INSERT MN ;MNEMONICS AND FIELD NAMES.
SA: JFCL↔SETZM PDLPTR ;FORCES RE-INITIALIZATION.
REE: MOVEI .↔DAC JOBREN↑ ;RE-ENTRY ADDRESS.
LAC 17,PDLIOWD ;ACCUMULATOR 17 IS CONTROL PDL.
OUTCHR[14]↔PGIOT 2, ;ADJUST III PAGE PRINTER.
PPIOT 2,-=250↔PPIOT 3,3003 ;3 GLITCHS OF 3 LINES.
MOVEI 2↔DAC DPYFLG ;TURN OFF HIDDEN LINES.
PUSHJ P,[GO TRAPINIT↑] ;INIT APR TRAPS.
CALL(GEOMED)↔EXIT↔LIT ;EXECUTE KEYBOARD COMMANDS.
;2/4/73(BGB)---------------------------------------------------------
SUBR(GEOMED) ;EXECUTE KEYBOARD COMMANDS.
COMMENT .-----------------------------------------------------------.
SKIPN PDLPTR↔CALL(GEONIT) ;INITIALIZATION WHEN NEEDED.
GO EXITN. ;NORMAL EXIT.
;COMMON EXITS FOR COMMAND EXECUTION ROUTINES.
↑EXITP.:AOS PDLPTR↔DAC 1,@PDLPTR ;EXIT PDL PUSH REFRESH.
↑EXITN.:OUTSTR[BYTE(7)15,12,"*"] ;THE MAIN CRLF STAR.
↑EXITR.:CALL(GEODPY↑) ;EXIT AND REFRESH DPY.
↑EXITQ.:CALL(STADPY) ;STATUS DISPLAY.
;READ COMMAND CHARACTER.
L1: LAC ALPHA↔DAC CTRL↔SETZM ALPHA ;CONTROL KEY PREFIX.
LAC BETA ↔DAC META↔SETZM BETA ; META KEY PREFIX.
CALL(GETCHW)↔DAC 1,0 ;WAIT FOR COMMAND CHAR.
TRZE 200↔SETOM CTRL ;CONTROL-KEY FLAG.
TRZE 400↔SETOM META ;META-KEY FLAG.
CAIN 15↔GO[SETZM ITERAT↔GO L1] ;CARRIAGE RETURN.
CAIN 12↔GO[OUTCHR ["*"]↔GO L1] ;LINE-FEED.
CAIG 172↔CAIGE 141 ;TEST FOR LOWER CASE.
SKIPA↔SUBI 40↔DAC CHR ;CONVERT INTO UPPER CASE.
LAC CTRL↔AND META↔DAC MTCT ;META-CONTROL FLAG.
SETZ↔SKIPE CTRL↔IORI 1 ;META-CONTROL BITS.
SKIPE META↔IORI 2↔DAC MCBITS
;DISPATCH THRU ASCII JUMP TABLE.
LAC 1,CHR↔LAC 0,1↔CAIGE 0,173 ;THE CHARACTER IN AC0.
SKIPA 1,A00(1)↔LAC 1,A173-173(1);THE COMMAND ADDRESS IN AC1.
CAR 1,1↔GO(1) ;CALL GEOMED COMMAND.
ENDR GEOMED;2/25/74(BGB)
;RETURNS FROM COMMAND EXECUTION TO GEOMED.
DEFINE EXITQ{GO EXITQ.} ;EXIT QUICK.
DEFINE EXITR{GO EXITR.} ;EXIT REFRESH.
DEFINE EXITN{GO EXITN.} ;EXIT NORMAL CRLF-STAR.
DEFINE EXITP{GO EXITP.} ;EXIT PUSH AC1 INTO PADPDL.
;2/4/73(BGB)---------------------------------------------------------
;EDITOR STATUS.
PDL↑: BLOCK =200 ;GEOMED'S INTERNAL STACK.
PDLIOWD: XWD PDL-.,PDL-1
;GEOMED SCRATCH PAD PUSH DOWN LIST.
PDLPTR↑: 0;PADPDL
PADPDL: BLOCK 100
DEFINE PSHPAD(X){AOS PDLPTR↔DAC X,@PDLPTR}
DEFINE POPPAD(X){LAC X,@PDLPTR↔SOS PDLPTR}
DEFINE REQUIR(X){CDR 1,PDLPTR↔CAIGE 1,PADPDL+X↔EXITQ}
;JUMP TABLE COMMAND SCANNER STATUS.
DECLARE{CHR,MCBITS,CTRL,META,MTCT,ALPHA,BETA}
;STRENGTH OF EUCLIDEAN TRANSFORMATION.
TDEL↑: 1.0 ;TRANSLATION DELTA STRENGTH.
RDEL↑: 0.785398;ROTATION DELTA STRENGTH.
DDEL↑: 0↔0.75 ;DILATION DELTA STRENGTH.
OPERAT: 0 ;DEFAULT EUCLIDEAN OPERATION.
FRAAM: 0 ;FRAME OF REFERENCE.
FRMORG: 0 ;USE FRAME OF REFERENCE ORIGIN.
AXECNT: 1 ;NUMBER OF AXES TO USE.
ITERAT: 0 ;NUMBER OF ITERATIONS.
FLAGL: -1 ;"L" COMMAND SWITCH. LABEL LIGHTS OF FEV.
FLAGLB: -1 ;"αL" COMMAND SWITCH. LABEL LIGHTS OF BODIES.
FLAGLF: 0 ;"βL" COMMAND SWITCH. DISPLAY GEOFRAME VECTORS.
FLAGLS: 0 ;"εL" COMMAND SWITCH. DISPLAY SUNSHINE VECTOR.
FLAGME: 0 ;METRIC SWITCH: -1 FOR CM, +1 FOR METERS.
FLAGD: 0 ;"∂" NODE DISPLAY ENABLE.
FLAGD2: 0 ;"α∂" FRAME FORMAT NODE DISPLAY ENABLE.
FLAGSD: -1 ;"≡" STATUS DISPLAY ENABLE.
DPYFLG↑:2 ;GEODPY STICKY DISPLAY MODE.
ODPYFLG: 2 ;OLD GEODPY STICKY DISPLAY MODE.
EXTERN GETCHL,GETCHW,UNIVER,AVAIL,OLD44
EXTERN FCW,FCCW,ECW,ECCW,VCW,VCCW,OTHER,LINKED
EXTERN MKEV,MKFE
SUBN(GEONIT) ;GEOMETRIC EDITOR INITIALIZATION.
COMMENT .-----------------------------------------------------------.
;CREATE A GEOMED UNIVERSE.
MOVEI PADPDL↔DAP PDLPTR ;SCRATCH PAD PUSH DOWN.
SETZM UNIVERSE
CALL(MKUNIV↑)
;SETUP STRENGTH OF TRANSFORMATION VALUES.
LAC[1.0]↔DAC TDEL ;TRANSLATION STRENGTH.
LAC[0.75]↔DAC DDEL ;DILATION STRENGTH.
LAC[0.785398]↔DAC RDEL ;ROTATION STRENGTH π/4.
;INITIALIZE
SETZM FRAAM ;SELECT WORLD FRAME. "F"
SETZM FRMORG ;GEOMED FRAME ORIGIN. "Q"
SETOM FLAGL ;TURN ON THE FEV LIGHTS. "L"
SETZM FLAGLB ;TURN OFF THE BODY LIGHTS. "αL"
SETZM FLAGLF ;TURN OFF THE FRAME LIGHTS."βL"
SETZM FLAGLS ;TURN OFF THE SUNSHINE "εL"
MOVEI 1↔DAC AXECNT ;ONE AXIS SELECT. "βA"
SETZM OPERAT ;TRANSLATION DEFAULT. "!@"
POP0J
ENDR GEONIT;2/25/74(BGB)---------------------------------------------
;ASCII 00 TO 37--------------------------------------------------
DEFINE $$(Q,A,B){XWD A,[ASCIZ"B"]}
A00: NOP ;null.
$$("↓",PADPSH,{ ↓ COPY PUSH. α↓ ROTATE PUSH.})
$$("α",{[SETOM ALPHA↔EXITQ]},{α CONTROL KEY PREFIX.})
$$("β",{[SETOM BETA↔EXITQ]},{β META KEY PREFIX.})
$$("∧",LINKER,{ ∧ FETCH PVT LINK})
$$("¬",XEVERT,{ ¬ BODY EVERT. α¬ BODY SUBTRACTION.})
$$("ε",{[SETOM ALPHA↔SETOM BETA↔EXITQ]},{ε META-CONTROL PREFIX.})
$$("π",XRDEL,{ π ACCEPT ROTATION DELTA.})
$$("λ",XTDEL,{ λ ACCEPT TRANSLATION DELTA.})
$$(" ",[EXITQ],{NOP TAB.})
$$(" ",NOP,{NOP LF.})
$$(" ",NOP,{NOP VT.})
$$(" ",NOP,{NOP FF.})
$$(" ",NOP,{NOP CR.})
$$("∞",INSTANT,{ ∞ INSTANT CUBE. α∞ INSTANT TORUS. β∞ X-EYE STEREO.})
$$("∂",SWCD,{∂ FLIP NODE DISPLAY SWITCH. α∂ FLIP NODE FORMAT SWITCH.})
$$("⊂",LINKER,{ ⊂ FETCH BRO LINK.})
$$("⊃",LINKER,{ ⊃ FETCH SIS LINK.})
$$("∩",LINKER,{ ∩ FETCH DAD LINK. α∩ BODY INTERSECTION.})
$$("∪",LINKER,{ ∪ FETCH SON LINK. α∪ BODY UNION.})
$$("∀",XDISBL,{∀ ENABLE ALL BODY MOTIONS;
DISABLE: α∀ FRAME MOTION. β∀ VERTEX MOTION. ε∀ PARTS MOTION.})
$$("∃",XTAB,{ COMMENT PREFIX.})
$$("⊗",LINKER,{ ⊗ FETCH UNIVERSE NODE.})
$$("↔",PADSWP,{1ST ↔ 2ND 1ST α↔ 3RD 1ST β↔ LAST 2ND ε↔ 3RD})
$$("_",XDPY,{ _ STICKY DISPLAY MODE SWITCH.})
$$("→",LINKER,{ → FETCH ALT2 LINK.})
$$("~",NOP,{ TILDE})
$$("≠",NOP,{ ≠})
$$("≤",LINKER,{ ≤ FETCH NED LINK.})
$$("≥",LINKER,{ ≥ FETCH PED LINK.})
$$("≡",SWCSD,{ TOGGLE: ≡ STATUS DISPLAY, α≡ BORDER DISPLAY.})
$$("∨",LINKER,{ ∨ FETCH NVT LINK.})
;----------------------------------------------------------------
;ASCII 40 TO 100-------------------------------------------------
$$(" ",XREDPY,{ REFRESH DISPLAY.})
$$("!",SWC1,{ ! TRANSLATION DEFAULT SWITCH.})
$$(" ",NOP,{ NOP - DOUBLE QUOTE.})
$$("#",CRLF20,{ # TWENTY CRLF'S. α# ENTER DDT.})
$$("$",XCONVEX,{ $ MAKE CONVEX. α$ ESLURP })
$$("%",XDDEL,{ % SET DILATION DELTA STRENGTH.})
$$("&",NOP,{ & NOP.})
$$("'",NOP,{ ' NOP.})
$$("(",EUTRAN,{ EUCLIDEAN TRANSFORMATION -Y.})
$$(" ",EUTRAN,{ EUCLIDEAN TRANSFORMATION +Y.})
$$("*",EUTRAN,{ EUCLIDEAN TRANSFORMATION +Z.})
$$("+",LINKER,{ OTHER LINK.})
$$(" ",LINKER,{ CLOCKWISE LINK.})
$$("-",EUTRAN,{ EUCLIDEAN TRANSFORMATION -Z.})
$$(".",LINKER,{ COUNTER CLOCKWISE LINK.})
$$("/",HALVE ,{ HALVE STRENGTH.})
$$("0",SETDIG,{ SET-DIGIT COMMAND.})
$$("1",SETDIG,{ SET-DIGIT COMMAND.})
$$("2",SETDIG,{ SET-DIGIT COMMAND.})
$$("3",SETDIG,{ SET-DIGIT COMMAND.})
$$("4",SETDIG,{ SET-DIGIT COMMAND.})
$$("5",SETDIG,{ SET-DIGIT COMMAND.})
$$("6",SETDIG,{ SET-DIGIT COMMAND.})
$$("7",SETDIG,{ SET-DIGIT COMMAND.})
$$("8",SETDIG,{ SET-DIGIT COMMAND.})
$$("9",SETDIG,{ SET-DIGIT COMMAND.})
$$(":",EUTRAN,{ EUCLIDEAN TRANSFORMATION +X.})
$$(";",EUTRAN,{ EUCLIDEAN TRANSFORMATION -X.})
$$("<",LINKER,{ FETCH NFACE LINK.})
$$("=",NOP,{ NOP.})
$$(">",LINKER,{ FETCH PFACE LINK.})
$$("?",QMARK,{ INFORMATION PREFIX.})
$$("@",SWC2,{ ROTATION DEFAULT SWITCH.})
;----------------------------------------------------------------
;ASCII 101 TO 132 UPPER CASE-------------------------------------
;ASCII 141 TO 172 LOWER CASE.
A101:
$$("A",ATTDET,{ A ATTACH, αA NOP, βAXECNT. εA NOP.})
$$("B",XBODY ,{ B GET BODY OF TOP FEV. αB BODY RETRIEVAL BY NAME OR NUMERAL.})
$$("C",XCOPY ,{ C COPY. αC GET CAMERA. βC MAKE CAMERA IN NOW WORLD})
$$("D",ATTDET,{ D DETACH. αDARKEN. βDUAL. εUNDARKEN.})
$$("E",SWIRE ,{ E SWEEP WIRE. εE EXIT.})
$$("F",SWCF,{ F FRAME STEP SWITCH. αF SET FOCAL IN MM. βF UNSTEP FRAME SWITCH.})
$$("G",XGLUE,{ G GLUE COMMAND.})
$$("H",COMHLP,{ H HELP. αH NO HELP.})
$$("I",XIN,{ I INPUT B3D. αI CAMERA. βI CRE. εI GEM.})
$$("J",JOINVV,{ J JOIN VERTEX-VERTEX.})
$$("K",XKILL,{ K KILL COMMAND. αK KILL EDGE AND VERTEX})
$$("L",SWCL,{ L LABEL LIGHTS SWITCH. αL BODY LIGHTS. βL FRAME LIGHTS.})
$$("M",MIDPOI,{ M MIDPOINT COMMAND.})
$$("N",XNAME,{ N NAME BODY.})
$$("O",XOUT,{ O OUTPUT B3D. αO CAMERA. βO V2D FOR MKVID. εO GEM.})
$$("P",XPLOTO,{ P OUTPUT PLOT FILE})
$$("Q",SWCQ,{ Q FRAME ORIGIN SWITCH.})
$$("R",XROTCM,{ R ROTATION COMPLETION.})
$$("S",XSWEEP,{ S SWEEP. αS PYRAMID. βS SMOOTH SWEEP. εSMOOTH PYRAMID.})
$$("T",XTAKE,{ T NOP - RESERVED FOR TEXT COMMANDS. αT TAKE SIMULATE IMAGE.})
$$("U",XUNMOVE,{U UNMOVE - RESETS BODY FRAME TO WORLD FRAME.})
$$("V",VBODY,{ V MAKE VERTEX BODY.})
$$("W",XWMAKE,{ MAKE: W WINDOW. αW WINDOW-DISPLAY. βW WORLD.})
$$("X",EXTEND,{X EXTENDED COMMANDS.})
$$("Y",NOP,{ Y NOP})
$$("Z",XZ,{ βZ TAKE COMMANDS FROM FILE.})
;ASCII 133 TO 140.
$$("[",NOP,{ NOP})
$$("\",DOUBLE,{ \ DOUBLE STRENGTH.})
$$("]",NOP,{ NOP})
$$("↑",PADPOP,{ ↑ PADPDL POP. α↑ ROTATE POP.})
$$("←",LINKER,{ ← FETCH ALT LINK.})
$$("`",NOP,{ NOP})
A173:
$$("{",XSTEP,{ -STEP NOW: DISPLAY, αWORLD, CAMERA OF β WORLD, OF ε WINDOW.})
$$("|",XINVERT,{ | INVERT EDGE PARITY.})
$$(" ",XDPY,{ ALT OCCULT. αALT FRONT FACE. βALT ALL EDGES.})
$$("}",XSTEP,{ +STEP NOW: DISPLAY, αWORLD, CAMERA OF β WORLD, OF ε WINDOW.})
$$(" ",NOP,{ RUBOUT})
;----------------------------------------------------------------
LIT
VBODY:; ;MAKE VERTEX BODY.
BEGIN VBODY
SKIPE CTRL↔GO L2
SETQ(BNEW,{MKB↑,[0]})↔PSHPAD 1 ;BODY INTO PADPDL
SKIPE META↔GO L1 ;DISABLE FACE & VERTEX.
CALL(MKF↑,BNEW)↔PSHPAD 1 ;FACE INTO PADPDL
CALL(MKV↑,BNEW)↔PSHPAD 1 ;VERTEX INTO PADPDL
L1: CALL(MKFRAME)↔LAC 2,BNEW
FRAME. 1,2↔EXITQ
L2: REQUIR(1)↔LAC 1,(1) ;"εV" FETCH I'TH VERTEX.
TEST 1,BBIT↔EXITQ↔DAC 1,BNEW
OUTSTR[ASCIZ/ :/]
CALL(REALIN)↔FIXX↔MOVM
LAC 1,BNEW↔PVT 1,1 ;FOLLOW VERTEX RING.
CAME 1,BNEW↔SOJG .-2
DAC 1,@PDLPTR↔OUTCHR["*"]↔EXITQ
DECLARE{BNEW}
BEND VBODY;2/4/73(BGB)
JOINVV: ;------------------------------------------------------------
BEGIN JOINVV
ACCUMULATORS{F,V1,V2,E1,E2}
REQUIR(2)
LAC V1,(1)↔LAC V2,-1(1)↔DAC V2,F
TEST V1,VBIT↔EXITQ ;AT LEAST ONE VERTEX.
TEST F,FBIT↔GO L1
;JOIN ENDS OF WIRE CASE.
PED E1,F↔PVT V2,E1↔DAC V2,(1)
CALL(MKFE,V2,F,V1)↔EXITR
;JOIN VERTICES ACROSS A FACE.
L1: TEST V2,VBIT↔EXITQ
PED E1,V1↔DAC E1,E0#
L2: SETQ(F,{FCCW,E1,V1})
PED E2,V2↔DAC E2,EE0#
L3: CALL(FCCW,E2,V2)↔CAMN 1,F↔GO L4 ;FACE IN COMMON.
SETQ(E2,{ECCW,E2,V2})↔CAME E2,EE0↔GO L3
SETQ(E1,{ECCW,E1,V1})↔CAME E1,E0↔GO L2↔EXITQ
L4: CALL(MKFE,V1,F,V2)↔SOS PDLPTR↔DAC 1,@PDLPTR
EXITR
BEND JOINVV;2/5/73(BGB)
MIDPOI: ;"M" MIDPOINT AN EDGE PROPORTIONAL TO DDEL.
BEGIN MIDPOI;---------------------------------------------------------
REQUIR(1)↔LAC 1,(1)↔TEST 1,EBIT↔EXITQ
PVT 0,1↔DAC V1
NVT 0,1↔DAC V2
CALL(ESPLIT↑,1)↔DAC 1,@PDLPTR
LAC 2,V1↔MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1)
LAC DDEL↔FMPRM XWC(1)↔FMPRM YWC(1)↔FMPRM ZWC(1)
LAC 2,V2↔MOVSI 3,(1.0)↔FSBR 3,DDEL
LAC XWC(2)↔FMPR 3↔FADRM XWC(1)
LAC YWC(2)↔FMPR 3↔FADRM YWC(1)
LAC ZWC(2)↔FMPR 3↔FADRM ZWC(1)
EXITR
DECLARE{V1,V2}
BEND MIDPOI;2/8/73(BGB)----------------------------------------------
XINVERT: ;"|" FLIP THE FACE-VERTEX ORIENTATION OF AN EDGE.
REQUIR(1)
LAC 1,(1)↔TEST 1,EBIT↔EXITQ
MOVSS 1(1)↔MOVSS 3(1)↔MOVSS 4(1)↔MOVSS 5(1)
EXITQ
XEVERT: ;"α¬" BODY SUBTRACTION.
SKIPE CTRL↔GO XBIN ; "¬" BODY EVERT.
REQUIR(1)↔LAC 1,(1)
TEST 1,BBIT↔EXITQ
CALL(EVERT↑,1)↔EXITR
XBIN:
REQUIR(2)
LAC 2,-1(1)↔LAC 1,(1)↔LAC CHR
CAIN"∩"↔GO[CALL(BIN↑,2,1)↔GO .+5] ;INTERSECTION.
CAIN"∪"↔GO[CALL(BUN↑,2,1)↔GO .+3] ;UNION.
CAIN"¬"↔GO[CALL(BSUB↑,2,1)↔GO .+1] ;SUBTRACTION.
PUSH P,1 ;SAVE RESULT MOMENTARILY.
CALL(GEODPY)
CALL(MKCVEX↑,{(P)})
SOS PDLPTR↔POP P,@PDLPTR ;ARGUMENTS HAVE BEEN KILLED.
EXITR
XTAKE: SKIPN META↔SKIPN CTRL↔EXITQ
CALL(TAKE1↑,[0])↔EXITN
XSWEEP:
BEGIN XSWEEP;--------------------------------------------------------
REQUIR(1)↔LAC 1,(1)
TESTZ 1,FBIT↔GO L2
TESTZ 1,EBIT↔GO[SETZM CTRL↔SETZM META↔GO XCOPY]
TEST 1,VBIT↔EXITQ
PED 2,1↔JUMPE 2,.+4
MOVS 0,1(2)↔CAME 0,1(2)↔GO[SETOM CTRL↔GO L2]
MOVNS ITERAT↔GO SWIRE ;SWEEP WIRE.
L2: SETZ 2,
SKIPE META↔HRLI 2,-1 ;SWEEP WITH "NOT SHARP" EDGES.
SKIPE CTRL↔GO[ ;αS PYRAMID SWEEP.
CALL(PYRAMID↑,1)↔DAC 1,@PDLPTR↔EXITR]
CALL(SWEEP↑,1,2)
L3: MOVNS ITERAT
LAC CHR↔CAIE "S"↔POPJ P,
EXITR
BEND XSWEEP;2/10/73(BGB)---------------------------------------------
SWIRE: ;------------------------------------------------------------
LAC 1,@PDLPTR↔SKIPE MTCT↔POP0J ;"εE" - EXIT GEOMED.
REQUIR(2)↔CALL(LINKED,{-1(1)},{(1)}) ;LEGAL ARGS TEST.
JUMPE 1,EXITQ.
CDR 1,PDLPTR↔CALL(MKEV,{-1(1)},{(1)}) ;MAKE EDGE VERTEX.
DAC 1,@PDLPTR
LAC CHR↔CAIN "E"↔EXITQ↔CAIE "S"↔POPJ P,
EXITQ
XROTCM: ;ROTATION COMPLETION.
REQUIR(1)↔LAC 1,(1)
TEST 1,FBIT↔EXITQ
CALL(ROTCOM↑,1)
EXITR
;--------------------------------------------------------------------
XGLUE: REQUIR(2) ;GLUE TWO FACES TOGETHER.
CALL(GLUE↑,{(1)},{-1(1)})
SOS PDLPTR↔DAC 1,@PDLPTR
EXITR
;--------------------------------------------------------------------
XKILL: ;"K"
BEGIN XKILL ;-------------------------------------------------------
REQUIR(1)↔LAC 1,(1)
LDB 2,[POINT 4,(1),35]
SUBI 2,14↔SKIPGE 2↔EXITQ ;B.F.E.V.
GO @[BKILL↔FKILL↔EKILL↔VKILL](2)
BKILL: CALL(KLBFEV↑,1) ;BODY KILL.
SOS PDLPTR
EXITR
FKILL: CALL(KLBFEV↑,1) ;FACE KILL.
DAC 1,@PDLPTR
EXITR
EKILL: SKIPE CTRL↔GO[ ;EDGE KILL.
CALL(KLBFEV↑,1)↔GO LEX] ;"αK" EDGE KILL.
CALL(KLFE↑,1) ;"K" EDGE KILL.
LEX: DAC 1,@PDLPTR
EXITR
VKILL: DAC 1,2↔PED 3,1 ;VERTEX KILL.
JUMPE 3,[PVT 1,1↔GO BKILL] ;POINT VERTEX CASE.
SETQ(4,{ECCW,3,2})
SETQ(5,{ECCW,4,2})
DAC 2,1↔CAMN 3,5↔GO[
CALL(KLEV↑,1)↔GO LEX]
CALL(KLEV,1)↔CALL(KLFE,1)↔GO LEX
BEND XKILL;2/10/73(BGB)-------------------------------------------------
EUTRAN: ;Apply a Euclidean transformation to an object.
BEGIN EUTRAN;--------------------------------------------------------
EXTERN BGET,APTRAN,MKFRAME,MKCOPY,KLNODE
EXTERN TRANSLATE,ROTATE,SHRINK
;GET TOP OBJECT OF PADPDL.
REQUIR(1)↔LAC 2,(1)↔DAC 2,OBJECT
$TYPE 0,2↔CAIN 0,$WINDOW↔GO WNTRAN ;DETECT WINDOW MOTION.
SETZM DEL1↔SETZM DEL2↔SETZM DEL3
;KIND OF TRANSFORMATION.
SKIPN 1,MCBITS↔LAC 1,OPERAT↔DAC 1,OP
LAC 2,[TRANSLATE↔ROTATE↔SHRINK↔SHRINK](1)
DAP 2,L3
;AXIS CODE.
LAC 1,CHR↔SETZ 3,
CAIE 1,";"↔CAIN 1,":"↔IORI 3,1 ;X-AXIS.
CAIE 1,"("↔CAIN 1,")"↔IORI 3,2 ;Y-AXIS.
CAIE 1,"-"↔CAIN 1,"*"↔IORI 3,4 ;Z-AXIS.
LAC 1,OP↔CAILE 1,1↔GO[ ;DILATION DEL DEFAULTS.
MOVSI(1.0)↔DAC DEL1↔DAC DEL2↔DAC DEL3
LAC AXECNT↔CAIN 2↔TRC 3,7 ;DILATION AXES.
CAIN 3↔TRO 3,7↔GO .+1]
;DELTA ARGUMENTS.
LAC CHR↔LAC 1,OP
LAC 2,@[TDEL↔RDEL↔DDEL↔[-1.0]](1)
CAIE 1,2↔GO .+3 ;FLIP DILATION...
CAML 2,[1.0]↔MOVNS 2 ;DEL GREATER THAN ONE.
CAIN"-"↔MOVNS 2
CAIN"("↔MOVNS 2
CAIN";"↔MOVNS 2
GO@[L1↔L1↔[MOVNS 2↔JUMPGE 2,L1 ;NEGATIVE DILATION.
MOVSI 2,(1.0)↔FDVR 2,DDEL↔GO L1] ;POSITIVE DILATION.
[LAC 2,[-1.0]↔GO L1]](1) ;REFLECTION DELTA.
L1: TRNE 3,1↔DAC 2,DEL1
TRNE 3,2↔DAC 2,DEL2
TRNE 3,4↔DAC 2,DEL3
;----- EUTRAN
;MAKE REFERENCE FRAME.
CALL(GEOFRM)
HRLZM 1,REFRAM ;XWD REFRAM,0
;MAKE EUCLIDEAN TRANSFORMATION MATRIX.
CALL(,REFRAM,DEL1,DEL2,DEL3)
L3: CALL(ROTATE)↔DAC 1,TRAN ;MAKE THE TRANSFORM.
SKIPE REFRAM↔GO[CAR REFRAM
SETZM REFRAM
CALL(KLNODE,0)↔GO .+1] ;FLUSH THE REFRAM.
;APPLY THE TRANSFORMATION TO THE OBJECT.
LAC ITERAT↔SKIPN↔AOS↔DAC COUNT
L2: CALL(APTRAN,OBJECT,TRAN)
CALL(GEODPY)
SKIPGE COUNT↔GO[
AOSL COUNT↔GO .+1
SETZM ITERAT
PUSHJ P,XSWEEP
LAC @PDLPTR↔DAC OBJECT↔GO L2]
SOSLE COUNT↔GO L2
SETOM@TRAN↔CALL(KLNODE,TRAN) ;FLUSH THE TRANSFROM.
EXITQ
DECLARE{OBJECT,TRAN,REFRAM,COUNT,OP,DEL1,DEL2,DEL3}
;--------------------------------------------------------------------
WNTRAN: LAC 1,CHR ;WINDOW TRANFORMATION.
CAIN 1,"-"↔GO[LAC -1(2)↔FMPR DDEL↔DAC -1(2)
SKIPE CTRL↔EXITR↔GO W1]
CAIN 1,"*"↔GO[LAC -1(2)↔FDVR DDEL↔DAC -1(2)
SKIPE CTRL↔EXITR↔GO W1]
LAC 3,TDEL↔FMPRI 3,(<100.0>)↔FIXX 3, ;TRANSLATION.
MOVEI 4,-2(2)↔SKIPE CTRL↔SOS 4 ;ADDRESS.
CAIN 1,";"↔GO[HLRE(4)↔SUB 3↔DIP(4)↔GO W1]
CAIN 1,":"↔GO[HLRE(4)↔ADD 3↔DIP(4)↔GO W1]
CAIN 1,"("↔GO[HRRE(4)↔SUB 3↔DAP(4)↔GO W1]
CAIN 1,")"↔GO[HRRE(4)↔ADD 3↔DAP(4)↔GO W1]↔EXITQ
W1: CALL(CROP,2)↔EXITR
BEND EUTRAN;2/4/73(BGB)-----------------------------------------------
SUBN(CROP,WINDOW)
COMMENT .-----------------------------------------------------------.
;Crop object window to III destination window.
; XL ← (OX - MAG*LDX) MAX -511.
; XH ← (OX + MAG*LDX) MIN +511.
; YL ← (OY - MAG*LDY) MAX -384.
; YH ← (OY + MAG*LDY) MIN +384.
ACCUMULATORS{WND,C,OX,OY,LDX,LDY,MAG}
LAC WND,WINDOW
NCAMR C,WND↔JUMPE C,POP1J.
LAC MAG,-1(WND)
HLRE OX,-2(WND)↔FLOAT OX,
HRRE OY,-2(WND)↔FLOAT OY,
LAC LDX,[144.0]
LAC LDY,[108.0]
LAC LDX↔FMPR MAG↔DAC OX,1
FSBR 1,0↔FADR 0,OX↔FIXX 0,↔FIXX 1,
CAMGE 1,[-=511]↔LAC 1,[-=511]↔DIP 1,1(WND)
CAMLE 0,[ =511]↔LAC 0,[ =511]↔DAP 0,1(WND)
LAC LDY↔FMPR MAG↔DAC OY,1
FSBR 1,0↔FADR 0,OY↔FIXX 0,↔FIXX 1,
CAMGE 1,[-=384]↔LAC 1,[-=384]↔DIP 1,2(WND)
CAMLE 0,[ =384]↔LAC 0,[ =384]↔DAP 0,2(WND)
POP1J
ENDR CROP;3/13/73(BGB)-----------------------------------------------
XUNMOVE: ;UNMOVE BODY FRAME OF REFERENCE.
BEGIN UNMOVE
REQUIR(1)↔LAC 1,(1) ;TAKES ONE ARGUMENT.
TEST 1,BBIT↔EXITQ ;WHICH IS A BODY.
FRAME 2,1↔JUMPE 2,EXITQ. ;WHICH MUST HAVE A FRAME.
CALL(MKCOPY↑,2)↔DAC 1,FRM#
CALL(INTRAN↑,FRM)
CALL(APTRAN↑,@PDLPTR,FRM) ;APPLY INVERSE TRANSFORMATION.
CALL(KLNODE,FRM)
LAC CHR↔CAIE "U"↔POP0J↔EXITR ;XUNMOVE CALLED BY X-ORIENT.
BEND UNMOVE;---------------------------------------------------------
SUBN(GEOFRM) ;MAKE CURRENT GEOMED FRAME OF REFERENCE.
COMMENT .------------------------------------------------------------.
;FRAME SELECT SWITCH.
LAC 1,PDLPTR↔CAIGE 1,PADPDL+1↔GO L0 ;WORLD FRAME.
LAC 1,FRAAM↔SETZM FRM
GO @[L0↔L1↔L2↔L3](1) ;JUMP DISPATCH.
L0: CALL(MKFRAM)↔GO L5 ;WORLD FRAME.
L1: CALL(BGET,@PDLPTR)↔GO L4 ;BODY FRAME.
L2: LAC 1,PDLPTR↔LAC 2,(1) ;TOP OF STACK.
TESTZ 2,FBIT↔GO[CALL(MKFFRM↑,2)↔GO L5] ;RELATIVE TO FACE FRAME.
CAIL 1,PADPDL+2↔LAC 2,1(1) ;2ND OF STACK.
TESTZ 2,FBIT↔GO[CALL(MKFFRM↑,2)↔GO L5] ;RELATIVE TO FACE FRAME.
CALL(BGET,@PDLPTR)↔LAC 2,@PDLPTR ;BODY GET. BODY GOTTEN ?
TEST 2,BBIT↔TDCA 1,1↔DAD 1,1↔GO L4 ;RELATIVE TO BODY FRAME.
L3: LAC 1,UNIVERSE↔NWRLD 1,1↔NCAMR 1,1 ;NOW CAMERA FRAME.
L4: SKIPE 1↔FRAME 1,1↔SKIPE 1 ;ZERO FRAME IS WORLD FRAME.
GO[CALL(MKCOPY,1)↔DAC 1,FRM↔GO .+1] ;COPY OF REFRAM.
SKIPN 1,FRM↔CALL(MKFRAME) ;MUST HAVE A FRAME NOW.
L5: DAC 1,FRM ;SAVE FRAME.
SKIPE FRMORG↔POP0J ;GEO-FRAME'S OWN ORIGIN.
CALL(BGET,@PDLPTR)↔FRAME 2,1 ;BODY FRAME OF THE OBJECT.
LAC 1,FRM↔JUMPE 2,POP0J.
MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1) ;BODY'S ORIGIN BECOMES...
POP0J ;GEO-FRAME'S ORGIN.
DECLARE{FRM}
BEND GEOFRM;---------------------------------------------------------
SUBN(DPYFRM) ;DISPLAY GEO FRAME OF REFERENCE.
COMMENT .-----------------------------------------------------------.
G ←← 15
LAC 1,UNIVERSE
CW 1,1↔NCAMR 1,1↔JUMPE 1,POP0J. ;NOW CAMERA OF NOW DISPLAY.
FRAME 1,1↔JUMPE 1,POP0J. ;CAMERA'S FRAME.
SETQ(CFRM,{MKCOPY,1})↔CALL(INTRAN↑,CFRM);INVERTED.
SETQ(GFRM,{GEOFRM}) ;GEO FRAME.
CALL(APTRAN↑,GFRM,CFRM) ;APPLY CFRM TO GFRM.
HRLZ G,GFRM↔BLT G,KZ ;GFRM TO ACCUMULATORS 0-9
;DISPLAY UNIT VECTORS OF GFRM.
FMPR IX,[300.0]↔FMPR IY,[300.0]↔FIXX IX,↔FIXX IY,
FMPR JX,[300.0]↔FMPR JY,[300.0]↔FIXX JX,↔FIXX JY,
FMPR KX,[300.0]↔FMPR KY,[300.0]↔FIXX KX,↔FIXX KY,
PUSH P,IZ↔PUSH P,[2]↔PUSH P,IX↔PUSH P,IY
PUSH P,JZ↔PUSH P,[2]↔PUSH P,JX↔PUSH P,JY
PUSH P,KZ↔PUSH P,[2]↔PUSH P,KX↔PUSH P,KY
CALL(AIVECT,[0],[0])↔CALL(AVECT)↔CALL(DPYSTR,[[ASCIZ/ +Z /]])↔CALL(FLODPY)
CALL(AIVECT,[0],[0])↔CALL(AVECT)↔CALL(DPYSTR,[[ASCIZ/ +Y /]])↔CALL(FLODPY)
CALL(AIVECT,[0],[0])↔CALL(AVECT)↔CALL(DPYSTR,[[ASCIZ/ +X /]])↔CALL(FLODPY)
CALL(KLNODE,CFRM)↔CALL(KLNODE,GFRM)↔POP0J
DECLARE{GFRM,CFRM}
ENDR DPYFRM;---------------------------------------------------------
;SWITCH COMMANDS.
; ! TRANSLATION DEFAULT.
; @ ROTATION DEFAULT.
; Q FLIP FRAME ORIGIN.
; F STEP FRAME SELECT SWITCH.
; ≡ TOGGLE STATUS DISPLAY ENABLE.
SWC1: SETZM OPERAT↔EXITQ ;"!" TRANSLATION DEFAULT.
SWC2: MOVEI 1↔DAC OPERAT↔EXITQ ;"@" ROTATION DEFAULT.
SWCF: SKIPE CTRL↔GO XFOCAL ;"αF" SET FOCAL.
SKIPE META↔SOSA 1,FRAAM
AOS 1,FRAAM↔ANDI 1,3
DAC 1,FRAAM↔EXITQ ;FRAME STEP SWITCH.
SWCL: LAC 1,MCBITS↔XCT[SETCMM FLAGL ;"L" FEV LABEL LIGHTS SWITCH.
SETCMM FLAGLB ;"αL" BODY LABEL LIGHTS.
SETCMM FLAGLF
SETCMM FLAGLS](1)↔EXITQ ;"βL" FRAME VECTOR LIGHTS.
SWCD: SKIPE CTRL↔SETCMM FLAGD2 ;"α∂" FRAME FORMAT NODE DISPLAY.
SKIPN CTRL↔SETCMM FLAGD↔EXITQ ;"∂" NODE DISPLAY SWITCH.
SWCQ: SETCMM FRMORG↔EXITQ ;FRAME ORGIN TOGGLE.
SWCSD: SKIPE CTRL↔GO .+3
SETCMM FLAGSD↔EXITQ ;"≡" STATUS DISPLAY TOGGLE.
LAC 1,UNIVERSE↔CW 1,1
LAC(1)↔TLC(DARKEN)↔DAC(1) ;"α≡" TOGGLE WINDOW BORDER.
CALL(GEODPY)↔EXITQ
CRLF20: SKIPE CTRL↔GO .+3
OUTSTR[BYTE(7)14,14,14]↔EXITQ ;"#" TWENTY CRLF'S.
SKIPN JOBDDT↑↔GO[OUTSTR[ASCIZ/ NO DDT./]↔EXITN]
CALL(DDTGO↑)↔EXITN ;"α#" ENTER DDT.
XDISBL: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔EXITQ
LAC 1,(1)↔TEST 1,BBIT↔EXITQ
LAC 2,MCBITS↔GO@[
[MARKZ 1,{BDLBIT+BDVBIT+BDPBIT}↔EXITQ] ;ENABLE.
[MARK 1,BDLBIT↔EXITQ] ;FRAME DISABLE
[MARK 1,BDVBIT↔EXITQ] ;VERTEX DISABLE
[MARK 1,BDPBIT↔EXITQ]](2) ;PARTS DISABLE
;--------------------------------------------------------------------
NOP: OUTCHR CHR
OUTSTR[ASCIZ/ NO OPERATION./]
CRLF↔EXITQ
;--------------------------------------------------------------------
;PRINT COMMAND CHARACTER COMMENT.
QMARK: CALL(GETCHW)↔OUTSTR[BYTE(7)15,12,11] ;CRLF-TAB.
CAIN 1,"X"↔GO[CRLF↔CALL(EXTTXT)↔EXITN] ;EXTENDED COMMANDS.
ANDI 1,177↔CDR A173-173(1) ;ASCII CODES 173 TO 177.
CAIG 1,172↔CDR A00-40(1) ;ASCII CODES 141 TO 172.
CAIG 1,140↔CDR A00(1) ;ASCII CODES 0 TO 140.
OUTSTR @↔EXITN
XTAB: CALL(GETCHW)
SKIPE CTRL↔OUTCHR 1 ;PRINT THE COMMENT.
CAIE 1,12↔GO XTAB
SKIPE META↔INCHRW ;WAIT A MOMENT FOR THE USER.
EXITQ
;STACK MODIFYING COMMANDS. ;"↔↓↑"
;"↔" PADPDL SWAP: PADPDL[1]↔PADPDL[2].
;"α↔" PADPDL SWAP: PADPDL[1]↔PADPDL[3].
;"β↔" PADPDL SWAP: PADPDL[2]↔PADPDL[3].
;"ε↔" PADPDL SWAP: PADPDL[1]↔PADPDL[N].
PADSWP: CDR 1,PDLPTR
MOVM 2,CTRL↔CAIGE 1,PADPDL+2(2)↔EXITQ ;ARG ∃ TEST.
LAC 2,MCBITS↔GO@[
[LAC(1)↔EXCH -1(1)↔DAC(1)↔EXITQ] ; 1ST & 2ND.
[LAC(1)↔EXCH -2(1)↔DAC(1)↔EXITQ] ;α 1ST & 3RD.
[LAC(1)↔EXCH PADPDL+1↔DAC(1)↔EXITQ] ;β 1ST & LAST.
[LAC -1(1)↔EXCH -2(1)↔DAC -1(1)↔EXITQ] ;ε 2ND & 3RD.
](2)↔ LIT
;"↓" PADPDL COPY PUSH DOWN.
;"α↓" PADPDL ROTATE DOWN.
PADPSH: REQUIR(1)
SKIPE CTRL↔GO .+4
PUSH 1,(1)↔DAP 1,PDLPTR↔EXITQ ;COPY PUSH.
LAC[XWD PADPDL+1,PADPDL]↔BLT -1(1)
LAC PADPDL↔DAC(1)↔EXITQ ;ROTATE PUSH.
;"↑" PADPDL POP UP.
;"α↑" PADPDL ROTATE UP.
PADPOP: HRRO 1,PDLPTR
CDR 1↔CAIGE PADPDL+1↔EXITQ
SKIPN CTRL↔GO[SOS PDLPTR↔EXITQ] ;PAD POP.
SUBI PADPDL↔POP 1,1(1)↔SOJG .-1 ;ROTATE POP
LAC 1,PDLPTR↔LAC 1(1)↔DAC PADPDL+1
EXITQ
;STRENGTH COMMANDS.
;"/" COMMAND.-----------------------------------------------------
HALVE: SKIPN 1,MCBITS↔LAC 1,OPERAT ;EUCLIDEAN OPERATION.
LAC TDEL(1)↔FSC -1↔DAC TDEL(1) ;"/" COMMAND.
EXITQ
;"\" COMMAND.-----------------------------------------------------
DOUBLE: SKIPN 1,MCBITS↔LAC 1,OPERAT ;EUCLIDEAN OPERATION.
LAC TDEL(1)↔FSC 1↔DAC TDEL(1) ;"\" COMMAND.
EXITQ
;"0123456789" COMMANDS.-------------------------------------------
SETDIG: LAC 1,CHR↔ANDI 1,17 ;DIGIT.
SKIPN 2,MCBITS↔LAC 2,OPERAT ;EUCLIDEAN OPERATION.
GO@[
[LAC ITERAT↔IMULI 12↔ADD 1 ;ITERATION COUNT.
CAILE=128↔LACI=128
DAC ITERAT↔EXITQ]
[SUBI 1,=10↔LAC[3.1415927] ;ROTATION DELTA.
FSC(1)↔DAC RDEL↔EXITQ]
[SKIPN 1↔MOVEI 1,1↔FLOAT 1, ;DILATION DELTA.
FMPR 1,[0.1]↔DAC 1,DDEL↔EXITQ]
[SUBI 1,4↔MOVSI(1.0)↔FSC(1) ;TRANSLATION DELTA.
DAC TDEL↔EXITQ]](2)
;-----------------------------------------------------------------
EXTERNAL REALI
REALIN: GO REALI
XTDEL: CALL(REALIN)↔SKIPE↔MOVMM TDEL↔EXITQ
XDDEL: CALL(REALIN)↔FMPR[0.01]↔SKIPE↔DAC DDEL↔EXITQ
XRDEL: CALL(REALIN)↔SKIPE↔MOVMM RDEL↔EXITQ ;RADIANS.
;COMMAND XFOCAL
XFOCAL:
OUTSTR[ASCIZ/ FOCAL = /]
CALL(REALIN)↔JUMPE 0,EXITN.↔MOVMS ;REJECT ZERO FOCAL LENGTH
LAC 1,UNIVERSE↔NWRLD 1,1↔NCAMR 1,1
XFOCA1: FMPR 0,[3.280833E-3]↔LAC 2,0 ;NEW FOCAL IN FEET.
EXCH 2,3(1)↔FDVR 0,2 ;(NEW-FOCAL / OLD-FOCAL).
FMPRM -3(1)↔FMPRM -2(1)↔FMPRM -1(1) ;UPDATE SCALES.
OUTSTR[ASCIZ/*/]↔EXITR
LINKER: ;LINK FOLLOWING COMANDS.
BEGIN LINKER;--------------------------------------------------------
LAC 15,PDLPTR
LAC CHR↔CAIN"⊗"↔GO[PUSH 15,UNIVERSE↔DAP 15,PDLPTR↔EXITQ]
CDR 1,15↔CAIGE 1,PADPDL+1↔GO[ ;STACK EMPTY.
CAIE"→"↔CAIN"←"↔GO L6↔EXITQ] ;STEP IMAGE RINGS.
LAC 2,(1)↔LAC CHR
CAIE"."↔CAIN","↔GO L1 ;CLOCK LINK COMMANDS.
CAIN"+"↔GO L1 ;OTHER LINK COMMAND.
CAIN"∩"↔GO[SKIPE CTRL↔GO XBIN↔DAD 2,2↔GO L0]
CAIN"∪"↔GO[SKIPE CTRL↔GO XBIN↔SON 2,2↔GO L0]
CAIN"⊂"↔GO[BRO 2,2↔GO L0]
CAIN"⊃"↔GO[SIS 2,2↔GO L0]
CAIE "<"↔CAIN ">"↔ADDI 2,1
CAIE "≤"↔CAIN "≥"↔ADDI 2,2
CAIE "∨"↔CAIN "∧"↔ADDI 2,3
CAIE "←"↔CAIN "→"↔GO[ADDI 2,6↔SKIPN MCBITS↔GO .+1↔GO L6]
SKIPE CTRL↔SUBI 2,4 ;-3 -2 -1
SKIPE META↔ADDI 2,5 ; 6 7 8
LAC 2,(2) ;FETCH WORD FROM THE NODE.
CAIN "≤"↔MOVSS 2
CAIN "<"↔MOVSS 2
CAIN "∨"↔MOVSS 2
CAIN "←"↔MOVSS 2
L0: CDR 2
CAML 44↔GO .+3 ;LOWER THAN MAX.
CAML UNIVER↔DAC(1) ;HIGHER THAN MIN.
EXITQ
;----- LINKER ;OTHER LINK COMMANDS.
L1: LAC(2)↔ANDI 17↔CAIGE $FACE
GO[ LAC CHR ;OBJECT CLOCK LINKS.
CAIN"."↔GO[CCW 2,2↔DAC 2,(1)↔EXITQ] ;CCW BODY.
CAIN","↔GO[ CW 2,2↔DAC 2,(1)↔EXITQ] ; CW BODY.
EXITQ]
CAIGE 1,PADPDL+2↔EXITQ ;TWO ARGUMENTS REQUIRED.
LAC 1,0(15)↔LAC 2,-1(15)
CALL(LINKED,1,2)↔SKIPN 1↔EXITQ ;WHICH ARE LINKED.
LAC 1,0(15)↔LAC 2,-1(15)
SETZ 3,↔LAC CHR
CAIN"+"↔GO L2
CAIE","↔AOS 3 ;DISTINGUISH CW & CCW.
SKIPN CTRL↔ADDI 3,2
SKIPE CTRL↔ADDI 3,4 ;DISTINGUISH OPERATION.
;EDGE IS IN THE FIRST POSITION OF THE STACK.
L2: TEST 1,EBIT↔GO L3 ;EDGE.
TEST 2,FBIT↔GO[TEST 2,VBIT↔EXITQ ;FACE OR VERTEX.
SKIPE CTRL↔ADDI 3,2↔GO .+1] ;CTRL VERTEX.
PUSH P,1↔PUSH P,2↔PUSHJ P,@L5(3)
CAIN 3,2↔AOS 15↔CAIN 3,3↔AOS 15
DAC 1,-1(15)↔EXITQ
;EDGE IS IN THE SECOND POSITION OF THE STACK.
L3: TEST 2,EBIT↔EXITQ
TEST 1,FBIT↔GO[TEST 1,VBIT↔EXITQ
SKIPE CTRL↔ADDI 3,2↔GO .+1]
PUSH P,2↔PUSH P,1↔PUSHJ P,@L5(3)
CAIN 3,2↔SOS 15↔CAIN 3,3↔SOS 15
DAC 1,0(15)↔EXITQ
L5: OTHER↔OTHER↔ECW↔ECCW↔VCW↔VCCW↔FCW↔FCCW
;STEP ALONG IMAGE RINGS OF THE "NOW" CAMERA.
L6: LAC 1,UNIVERSE↔NWRLD 1,1↔NCAMR 1,1 ;NOW CAMERA
SKIPE CTRL↔GO L7
PIMAG 2,1↔SKIPN 2↔EXITQ↔PTIME 3,2↔CAIE"→"↔NTIME 3,2↔PIMAG. 3,1
CALL(GEODPY)↔EXITQ
L7: SIMAG 2,1↔SKIPN 2↔EXITQ↔PTIME 3,2↔CAIE"→"↔NTIME 3,2↔SIMAG. 3,1
CALL(GEODPY)↔EXITQ
BEND LINKER;2/9/73(BGB)----------------------------------------------
XNAME: ;NAME A BODY (OR A WORLD)
BEGIN XNAME;---------------------------------------------------------
REQUIR(1)
CALL(NTYPE,@PDLPTR)
CAIN 1,$BODY↔GO .+3
CAIE 1,$WORLD↔EXITQ
CALL(RDNAME)
JUMPE 6,[ OUTSTR[ASCIZ/ILLEGAL NAME.
*/]↔ EXITQ]
CALL(FDNAME)
GO [ LAC 1,@PDLPTR
DAC 4,-2(1)↔DAC 5,-1(1)
OUTSTR[ASCIZ/*/]↔EXITQ ]
OUTSTR[ASCIZ/NAME ALREADY IN USE.
*/]↔ EXITQ
BEND XNAME;2/9/73(BGB)-----------------------------------------------
XBODY: ;BODY RETRIEVAL.
BEGIN XBODY;---------------------------------------------------------
SKIPN CTRL↔GO[CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔GO .+1
CALL(BGET,{(1)})↔DAC 1,@PDLPTR↔EXITQ]
CALL(RDNAME)↔JUMPN 6,L2
;FETCH BODY BY ITS SERIAL NUMBER.
LAC 1,UNIVERSE↔NWRLD 1,1 ;GET NOW WORLD.
DAC 1,WORLD#↔CCW 1,1
CAME 1,WORLD↔SOJG 3,.-2
CAME 1,WORLD↔GO RET
LOSE: OUTSTR[ASCIZ/BODY NOT FOUND.
*/]↔ EXITQ
;FETCH BODY BY ITS PNAME.
L2: CALL(FDNAME)↔GO LOSE
RET: PSHPAD 1↔OUTCHR["*"]↔EXITQ
BEND XBODY;2/9/73(BGB)-----------------------------------------------
SUBR(RDNAME)
;--------------------------------------------------------------------
OUTSTR[ASCIZ/ :/]
MOVEI 2,=10 ;TEN CHARACTERS TO A NAME.
LAC 7,[POINT 7,4,-1]
SETZB 3,6 ;BODY SERIAL NUMBER.
SETZB 4,5
L: CALL(GETCHL)↔CAIN 1,15↔GO EOL ;END OF LINE.
IDPB 1,7↔CAIGE 1,"0"↔GO .+3↔CAIG 1,"9"↔GO[
IMULI 3,12↔ANDI 1,17↔ADD 3,1↔GO .+2]
SETOM 6 ;NON-NUMERIC CHR SEEN.
SOJG 2,L
CALL(GETCHL)↔CAIE 1,15↔GO .-2
CRLF↔SKIPA
EOL: CALL(GETCHL)
POP0J
ENDR RDNAME;(TVR)----------------------------------------------------
SUBR(FDNAME)STRING ;FETCH BODY BY ITS PNAME
COMMENT .-----------------------------------------------------------.
;EXPECTS STRING IN AC'S 4 & 5.
IFN SAIL{LAC 16,SAIL16↑↔POP 16,STRING#
POP 16,0↔HRRZM STRCNT#↔DAC 16,SAIL16
LAC 0,[POINT 7,4]↔SETZB 4,5
SOSGE STRCNT↔TDCA 1,1↔ILDB 1,STRING
IDPB 1,0↔JUMPN 1,.-4}
LAC 1,UNIVERSE↔NWRLD 1,1↔DAC 1,WORLD# ;GET "NOW" WORLD.
L1: CCW 1,1↔CAMN 1,WORLD↔GO L2 ;SCAN THE BODIES.
CAME 4,-2(1)↔GO L1↔CAME 5,-1(1)↔GO L1 ;COMPARE THE NAMES.
IFE SAIL{AOS(P)} ;SKIP NAME FOUND.
POP0J ;RETURN BODY.
L2: SETZ 1,↔POP0J ;RETURN ZERO NAME NOT FOUND.
ENDR FDNAME;BGB 9 FEBRUARY 1973 ------------------------------------
INSTANT:
BEGIN INSTANT
OPDEF PTO[711440B17]
LAC 1,MCBITS
PTO @[[0↔MACRO0]
[0↔MACRO1]
[0↔MACRO2]
[0↔MACRO3]] (1)
EXITQ
MACRO0: ASCIZ"V\:)\E;E(E:J↑/*S--↑/@/:)\!"
MACRO1: ASCIZ"V:7@S*J!↑8/:\@S)↓>G↑:)!"
MACRO2: ASCIZ|!β5⊗,-βCβ{W↔↑-ε4)↔)/)↔):↔;\\;↔:λ1.5"
∩;↑∩:↑ε4|
MACRO3: 0
BEND INSTANT;2/9/73(BGB)---------------------------------------------
ATTDET: ;ATTACH-DETACH COMMANDS & FRIENDS.
BEGIN ATTDET;--------------------------------------------------------
EXTERN BDET,BATT,FVDUAL
LAC 1,CHR↔CAIE 1,"D"↔GO L4
;DETACH, αDARKEN, βDUAL, εUNDARKEN.
REQUIR(1)↔LAC 1,(1)
TEST 1,BBIT↔GO L3
SKIPN MTCT↔GO L2
MOVSI 0,(DARKEN)↔SKIPA 2,1 ;UNDARKEN A BODY.
ANDCAM(2)↔PED 2,2
CAME 1,2↔GO .-3
EXITR
L2: SKIPE META↔GO[CALL(FVDUAL,1)↔EXITR]
CALL(BDET,1)↔EXITQ
L3: LAC(1)↔ANDI 17↔CAIN 5↔GO .+3↔CAIE 16↔EXITQ ;WORLD OR EDGE.
MOVSI 0,(DARKEN)↔IORM(1)
SKIPE META↔ANDCAM(1)
EXITR
;ATTACH, αNOP, βAXECNT.
L4: SKIPE CTRL↔JFCL
SKIPE META↔GO[AOS 1,AXECNT ;STEP AXECNT.
CAIL 1,4↔MOVEI 1,1↔DAC 1,AXECNT
EXITQ]
REQUIR(2) ;ATTACH.
CALL(BATT,{(1)},{-1(1)})
EXITQ
BEND ATTDET;2/9/73(BGB)----------------------------------------------
XDPY:
LAC 1,CHR
CAIN 1,"_"↔GO[LAC MCBITS↔DAC DPYFLG↔CALL(GEODPY)↔EXITQ]
CAIE 1,175↔EXITQ
LAC MCBITS↔PUSH P,DPYFLG↔DAC DPYFLG↔DAC ODPYFLG
CALL(GEODPY)↔POP P,DPYFLG↔EXITQ
XCOPY:
BEGIN XCOPY
;βC - MAKE CAMERA IN NOW WORLD.
SKIPE META↔GO[
LAC 1,UNIVERSE↔NWRLD 1,1↔CALL(MKCAMERA↑,1)↔EXITP]
;βC - FETCH CAMERA IN NOW WORLD.
SKIPE CTRL↔GO[LAC 1,UNIVERSE↔NWRLD 1,1↔NCAMR 1,1↔EXITP]
; C - COPY.
REQUIR(1)
CALL(MKCOPY↑,{(1)})
MOVEI 2↔DAC DPYFLG↔EXITP ;DON'T OCCULT.
LIT
BEND XCOPY
;INPUT OUTPUT COMMANDS.
XIN: LAC 1,MCBITS↔GO@[
[CALL(INB3D↑)↔SKIPN 1↔EXITQ↔EXITP] ; I B3D.
[CALL(INCAM↑)↔EXITN] ;αI CAM.
[CALL(INCRE↑)↔EXITN] ;βI CRE.
[CALL(INGEM↑)↔SKIPN 1↔EXITQ↔EXITP] ;εI GEM.
](1)↔ LIT
XOUT: LAC 1,MCBITS↔GO@[
[REQUIR(1)↔CALL(OUTB3D↑,{(1)})↔EXITN] ; O B3D.
[CALL(OUTCAM↑)↔EXITN] ; αO CAM.
[CALL(OUTV2D↑)↔EXITN] ; βO V2D.
[REQUIR(1)↔CALL(OUTGEM↑,{(1)})↔EXITN] ; εO GEM.
](1)↔ LIT
XPLOTO: CALL(PLOTO↑)↔OUTCHR["*"]↔EXITQ
XZ: SKIPE META↔SKIPE CTRL↔EXITQ
CALL(INGEO↑)↔EXITN
COMHLP: ;HELP COMMAND.
SKIPE CTRL↔GO[SETZB 0,1 ;"αH" CLEAR HELP DISPLAY.
UPGIOT 16,0↔EXITQ]
CALL(TVHELP↑,[[SIXBIT/GEOMEDBGB/↔0↔SIXBIT/ SDOC/]])
EXITQ
; W - MAKE WINDOW IN "NOW" DISPLAY RING.
;αW - MAKE WINDOW IN A NEW DISPLAY RING.
;βW - MAKE WORLD AT END OF WORLD RING.
XWMAKE:
BEGIN XWMAKE
SKIPE META↔GO[CALL(MKWORLD↑)↔EXITP]
LAC 1,UNIVERSE↔CW 2,1 ;"NOW" DISPLAY.
NWRLD 1,1↔NCAMR 1,1 ;"NOW" CAMERA.
SKIPE CTRL↔SETZ 2, ;NEW DISPLAY DESIRED.
CALL(MKWINDOW↑,1,2)
EXITP
LIT
BEND XWMAKE
;--------------------------------------------------------------------
; { } STEP NOW DISPLAY.
;α{ } STEP NOW WORLD.
;β{ } STEP NOW CAMERA OF THE NOW WORLD.
;ε{ } STEP NOW CAMERA OF THE NOW DISPLAY.
XSTEP:
BEGIN XSTEP
LAC 1,UNIVERSE
SKIPE META↔GO L1
SKIPE CTRL↔GO L2
CW 2,1↔ CAIN"}"↔CCW 2,2↔CAIN"{"↔CW 2,2↔CW. 2,1
EXITR
L1: SKIPE CTRL↔CW 1,1 ;NOW DISPLAY.
SKIPN CTRL↔NWRLD 1,1 ;NOW WORLD.
NCAMR 2,1↔JUMPE 2,[EXITQ]
CAIN"}"↔SIS 2,2↔CAIN"{"↔BRO 2,2↔NCAMR. 2,1↔EXITR
L2: NWRLD 2,1↔JUMPE 2,[EXITQ]
CAIN"}"↔SIS 2,2↔CAIN"{"↔BRO 2,2↔NWRLD. 2,1↔EXITR
LIT
BEND XSTEP
XCONVEX: ;FORCE CONVEX FACES.
REQUIR(1)
SKIPE CTRL↔GO[
CALL(ESLURP↑,@PDLPTR)↔EXITR] ;EDGE SLURP.
CALL(MKCVEX↑,@PDLPTR)↔EXITR
XREDPY: ;REDISPLAY.
CALL(STADPY)
PUSH P,DPYFLG
LAC ODPYFLG
DAC DPYFLG
CALL(GEODPY)
POP P,DPYFLG
EXITQ
EXTEND: ;"X"-EXTEND COMMANDS.
BEGIN EXTEND:;-------------------------------------------------------
OUTSTR[ASCIZ/ COMMAND? /]
MOVEI 2,3↔SETZ 3, ;THREE CHARACTERS EXPECTED.
L1: CALL(GETCHL)↔LAC 1
CAIE 40↔CAIN 175↔GO L2 ;TEST FOR END OF COMMAND NAME.
CAIN 15↔GO[CALL(GETCHL)↔GO L2]
CAIN "("↔JUMPG 3,L1 ;IGNORE EARLY LEFT PARENS.
CAIN "("↔GO L2
CAIL"a"↔SUBI 40 ;SUPRESS LOWER CASE.
SOJL 2,L1 ;SUPRESS EXCESS LETTERS.
SUBI 40↔ROT 3,6↔IOR 3,0↔GO L1 ;PACK CHARACTER INTO AC3.
;SCAN EXTENDED COMMAND JUMP TABLE FOR A MATCH.
L2: MOVEI 1,BEGXJT↔CDR 2,(1)
CAMN 3,2↔GO[CAR(1)↔GO@]
CAIE 1,ENDXJT↔AOJA 1,L2+1
OUTSTR[ASCIZ/ --- NO SUCH COMMAND.
*/]↔ EXITQ
BEND EXTEND;7/19/73(BGB)---------------------------------------------
;EXTENDED COMMAND JUMP TABLE.
DEFINE EXTTAB
<
X$ XCUBE,CUB,<MAKE CUBIC PRISM OF DIMENSIONS X,Y,Z.>
X$ XCYLN,CYL,<MAKE CYLINDER OF RADIUS, NUMBER OF SIDES, HEIGHT.>
X$ XBALL,BAL,<MAKE SPHERE OF RADIUS, M LONGITUDES, N LATITUDES.>
X$ XCOLOR,COL,<COLORING. COLORING ARGUMENTS: 00R 00B 00G 00A>
X$ XNSHAR,NSH,<EDGES NOT SHARP.>
X$ XSCROL,SCR,<SCROLL THE CAMERA'S VISIBLE EDGES.>
X$ XPLACE,PLA,<PLACE CAMERA OR BODY OR SUN AT X,Y,Z.>
X$ XORIEN,ORI,<ORIENT CAMERA OR BODY TO PAN, TILT, SWING.>
X$ XCUT,CUT,<CUT A BODY.>
X$ XCONE,SIL,<MAKE SILOUHETTE CONE.>
X$ XPRISM,PRI,<PRISMIODAL SWEEP.>
X$ XFEET,FEE,<SET TO FEET.>
X$ XMETR,MET,<SET TO METERS.>
X$ XCMET,CM,<SET TO CENTIMETERS.>
>
DEFINE X$(ADR,SIX,MSG) < XWD ADR,'SIX' ;MSG
>
BEGXJT: EXTTAB
ENDXJT: XWD [EXITQ],0 ;EMPTY COMMAND.
DEFINE X$(ADR,SIX,MSG) <OUTSTR[ASCIZ/SIX MSG
/]↔>
EXTTXT: EXTTAB
POP0J
0
LIT
XPRISM: REQUIR(1)
CALL(SWEEP↑,@PDLPTR,[1])
EXITR
XCUBE: ;MAKE CUBIC PRISM. "X-CUB".
CALL(REALIN)↔PUSH P, ;DELTA-X
CALL(REALIN)↔PUSH P, ;DELTA-Y
CALL(REALIN)↔PUSH P, ;DELTA-Z
CALL(MKCUBE↑)↔EXITP
XCYLN:
CALL(REALIN)↔PUSH P, ;RADIUS.
CALL(REALIN)↔PUSH P, ;N SIDES.
CALL(REALIN)↔PUSH P, ;HEIGHT.
CALL(MKCYLN↑)↔EXITP
XBALL:
CALL(REALIN)↔PUSH P, ;RADIUS.
CALL(REALIN)↔PUSH P, ;M LONGITUDES.
CALL(REALIN)↔PUSH P, ;N LATITUDES.
CALL(MKBALL↑)↔EXITP
XCUT:
REQUIR(1)↔PUSH P,@PDLPTR ;BODY.
SKIPE MTCT↔GO[LAC 1,UNIVERSE
NWRLD 1,1↔CALL(KLTMPS↑,1)↔EXITN];UNCUT.
CALL(REALIN)↔PUSH P, ;DX.
CALL(REALIN)↔PUSH P, ;DY.
CALL(REALIN)↔PUSH P, ;DZ.
LAC 1,MCBITS↔PUSHJ P,@[BCUT↑↔FCUT↑↔ECUT↑](1)
EXITN
XCONE:
REQUIR(1)↔PUSH P,@PDLPTR ;BODY OR FACE OF CONE.
CALL(REALIN)↔PUSH P, ;ZMIN.
CALL(REALIN)↔PUSH P, ;ZMAX
CALL(MKCONE↑)↔EXITP
XFEET: SETZM FLAGME↔EXITN
XMETR: MOVEI 1↔DAC FLAGME↔EXITN
XCMET: SETOM FLAGME↔EXITN
XNSHARP: ;MARK ALL EDGES NOT-SHARP.
BEGIN NSHARP;--------------------------------------------------------
ACCUMULATORS{B,E}
;GET ARGUMENT FROM TOP OF STACK.
REQUIR(1)
LAC B,(1)↔LAC E,B
TEST E,EBIT↔PED E,B ;EDGE OR FIRST EDGE.
L1: TEST E,EBIT↔EXITN ;NOT AN EDGE.
MARK E,NSHARP
PED E,E↔GO L1
BEND NSHARP;8/7/73(BGB)----------------------------------------------
XORIEN: TDCA 13,13 ;ORIENT PAN,TILT,SWING.
XPLACE: SETO 13, ;PLACE AT LOCUS X,Y,Z.
CALL(REALIN)↔DAC 10 ;XWC OR PAN.
CALL(REALIN)↔DAC 11 ;YWC OR TILT.
CALL(REALIN)↔DAC 12 ;ZWC OR SWING.
REQUIR(1)↔CALL(NTYPE,@PDLPTR) ;TAKES ONE ARGUMENT.
CAIN 1,$BODY↔GO .+5 ;WHICH MUST BE A BODY,
CAIN 1,$CAMERA↔GO .+3 ;...CAMERA OR SUN NODE.
CAIE 1,$SUN↔EXITQ↔LAC 1,@PDLPTR
FRAME 2,1↔JUMPE 2,EXITQ. ;WHICH MUST HAVE A FRAME.
;PLACE.
JUMPN 13,[FSBR 10,XWC(2)
FSBR 11,YWC(2)↔FSBR 12,ZWC(2)
CALL(TRANSL↑,@PDLPTR,10,11,12)↔EXITR]
;ORIENT.
PUSH P,2 ;SAVE FRAME POINTER.
CALL(MKROT1↑,10,11,12)↔POP P,2 ;NEW ROTATION MATRIX.
MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1) ;BODY'S ORIGIN.
CALL(,1,@PDLPTR,1)↔SETZM CHR ;PUSH APTRAN ARGS.
CALL(XUNMOVE)↔CALL(APTRAN↑) ;UNDO AND DO AGAIN.
CALL(KLNODE↑)↔EXITR ;FLUSH MKROT1 FRAME.
;--------------------------------------------------------------------
XSCROL: ;SCROLL CAMERA VISIBLE EDGES.
BEGIN XSCROL
ACCUMULATORS{W,X,Y,Z,D}
LAC 1,UNIVERSE↔CW 1,1↔DAC 1,WINDOW
MOVEI 1,=64↔DAC 1,DELTA
CALL(SHOW2↑,WINDOW,[-1]) ;OCCULT - BUT NO KLTEMPS.
OUTSTR[ASCIZ/ #/]
CALL(GETCHW)↔CAIN 1,12 ;SUPPRESS EXTRA LF.
L1: CALL(GETCHW)
SETZM CTRL↔SETZM META
TRZE 1,200↔SETOM CTRL
TRZE 1,400↔SETOM META
CAIE 1,15↔CAIN 1,12↔GO L2
LAC W,WINDOW
HLRE X,-3(W)↔HRRE Y,-3(W)
LAC Z,-1(W)↔LAC D,DELTA
CAIN 1,"/"↔ASH D,-1↔CAIN 1,"\"↔ASH D,1
CAIN 1,":"↔ADD X,D↔CAIN 1,";"↔SUB X,D
CAIN 1,")"↔ADD Y,D↔CAIN 1,"("↔SUB Y,D
CAIN 1,"*"↔FMP Z,[1.2]↔CAIN 1,"-"↔FMP Z,[0.833334]
DIP X,-3(W)↔DAP Y,-3(W)
DAC Z,-1(W)↔SKIPE D↔DAC D,DELTA
SKIPE CTRL↔GO .+3
CALL(CROP,WINDOW)
CALL(CLIPER↑,WINDOW)
CALL(IIIDPY↑,WINDOW,[1])
GO L1
L2:
LAC W,WINDOW
LAC[3.5]↔DAC -1(W)
SETZM -3(W)
NCAMR 1,W↔PWRLD 1,1
CALL(KLTMPS↑,1)↔EXITR
DECLARE{WINDOW,DELTA}
BEND XSCROL;8/12/73(BGB)---------------------------------------------
XCOLOR: ;COLORING X-COMMAND.
BEGIN XCOLOR;--------------------------------------------------------
ACCUMULATORS{B,F,W4,W5}
;GET ARGUMENT FROM TOP OF STACK.
REQUIR(1)↔LAC B,(1)↔LAC F,B
TEST F,FBIT↔PFACE F,B ;FACE OR FIRST FACE.
TEST F,FBIT↔EXITQ↔PUSH P,F↔PUSH P,B
;OLDE AND NEW VALUES.
LAC 4(F)↔DAC WORD4
LAC 5(F)↔DAC WORD5
SETOM ALBEDO↔SETOM RED
SETOM GRN↔SETOM BLU↔GO L1B
;DECODE COLORING ARGUMENTS. 00R 00B 00G 00A
L1: CALL(GETCHL)↔LAC 1
CAIE 15↔CAIN 12↔GO L2
L1B: CALL(REALIN)
CAIN 1,"A"↔MOVMM ALBEDO
CAIN 1,"R"↔MOVMM RED
CAIN 1,"G"↔MOVMM GRN
CAIN 1,"B"↔MOVMM BLU
CAIE 1,15↔GO L1
;SETUP NEW PHOTOMETRIC PARAMETERS.
L2: SKIPGE 1,ALBEDO↔GO L2R ;ALBEDO.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔MOVEI 1,777
DPB 1,[POINT 9,WORD4,35]
L2R: SKIPGE 1,RED↔GO L2G ;RED.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔MOVEI 1,777
DPB 1,[POINT 9,WORD4,8]
L2G: SKIPGE 1,GRN↔GO L2B ;GREEN.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔MOVEI 1,777
DPB 1,[POINT 9,WORD4,17]
L2B: SKIPGE 1,BLU↔GO L3 ;BLUE.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔MOVEI 1,777
DPB 1,[POINT 9,WORD4,26]
L3: LAC W4,WORD4↔LAC W5,WORD5↔POPP B↔POPP F
L4: DAC W4,4(F)↔DAC W5,5(F)
CAMN B,F↔EXITQ↔PFACE F,F
CAMN B,F↔EXITQ↔GO L4
DECLARE{ALBEDO,RED,GRN,BLU,WORD4,WORD5}
BEND XCOLOR;7/20/73(BGB)---------------------------------------------
SUBR(STADPY) ;STATUS DISPLAY
COMMENT .-----------------------------------------------------------.
EXTERN DECDPY,DPYSTR,DTYO,DPYBRT
EXTERN AIVECT,AVECT,BUFDPY,FLODPY,DPYOUT,DPYSET
L0: CALL(DPYSET,BUFDPY↑)
SKIPN FLAGSD↔GO L5
YDEL ←← -=45 ;KEEP IT OUT OF THE WHO LINE.
;STATUS OF FRAME SELECT.
CALL(AIVECT,[=180],[=500+YDEL])
LAC 1,FRAAM
PUSH P,[
[ASCIZ/WORLD/]
[ASCIZ/BODY/]
[ASCIZ/RELATIVE/]
[ASCIZ/CAMERA/]](1)
CALL(DPYSTR)
;STATUS OF FRAME ORIGIN SWITCH.
MOVEI[ASCIZ/ FRAME/]
SKIPE FRMORG
MOVEI[ASCIZ/ FRAME */]
CALL(DPYSTR,0)
;STATUS OF OPERAT SELECT SWITCH.
CALL(AIVECT,[=365],[=500+YDEL])↔LAC 1,OPERAT
PUSH P,[[ASCIZ/TRANSLATION/]↔[ASCIZ/ROTATION/]](1)
CALL(DPYSTR)
;DISPLAY NUMERAL IF THERE IS MORE THAN ONE.
LAC 1,UNIVERSE↔CAR 2,7(1)↔CDR 7(2)↔CAME 2↔GO[
CDR 1,7(1)↔SKIPA 3,[1]↔CAR 2,7(2)
CAME 1,2↔AOJA 3,$.-2↔PUSH P,3
CALL(AIVECT,[=400],[=440+YDEL])
CALL(DPYSTR,{[[ASCIZ/DISPLAY /]]})↔CALL(DECDPY)↔GO .+1]
;NOW WORLD & NOW CAMERA IF THERE IS MORE THAN ONE.
LAC 1,UNIVERSE↔PWRLD 2,1↔NCAMR 1,2 ;FIRST WORLD & ITS NOW CAMERA.
SETZ 3,
CDR 5(2)↔CAME 2↔SETO 3,
CDR 5(1)↔CAME 1↔SETO 3,
JUMPN 3,[LAC 1,UNIVERSE↔NWRLD 2,1↔NCAMR 1,2
SKIPN 1↔EXCH 1,2↔PUSH P,1 ;DISPLAY NOW CAMERA OF NOW WORLD.
CALL(AIVECT,[=180],[=440+YDEL])
CALL(IDPY)↔GO .+1]
;----- STADPY
;TRANSLATION STRENGTH.
CALL(AIVECT,[=185],[=480+YDEL])
CALL(FLODPY,TDEL,[4])
LAC 1,FLAGME
PUSH P,[[ASCIZ/ CM/]↔[ASCIZ/ FEET/]↔[ASCIZ/ METERS/]]+1(1)
CALL(DPYSTR)
;ROTATION STRENGTH IN PI FRACTION.
CALL(AIVECT,[=185],[=460+YDEL])
L1: LAC RDEL↔LAC 1,[3.15]
CAMLE[6.28]↔GO L2
CAML[2.0]↔GO[FSC 1,1↔PUSH P,1
CALL(DTYO,["2"])↔POP P,1
GO .+1]
FDVR 1,RDEL↔FIX 1,233000↔PUSH P,1
CALL(DPYSTR,{[[ASCIZ"π/"]]})
CALL(DECDPY)
L2:
;RDEL IN DEGREES, MINUTES AND SECONDS.
CALL(AIVECT,[=270],[=460+YDEL])
LAC 1,RDEL↔FMPR 1,[206264.806] ;SECONDS.
FIX 1,233000
AOS 1↔IDIVI 1,=3600↔IDIVI 2,=60
PUSH P,3↔PUSH P,2↔PUSH P,1
CALL(DECDPY)↔CALL(DTYO,[" "])
CALL(DECDPY)↔CALL(DTYO,[" "])
CALL(DECDPY)
;DILATION STRENGTH.
CALL(AIVECT,[=390],[=480+YDEL])
LAC DDEL↔FMP[100.0]↔FADR[0.001]
CALL(FLODPY,0,[2])
CALL(DTYO,["%"])
CALL(DTYO,[" "])
LAC AXECNT↔ADDI 60↔CALL(DTYO,0)
;SHOW SUNSHINE VECTOR.
SKIPE FLAGLS↔GO[
BEGIN
Q←12 ↔ R←13 ↔ S←14
CALL(AIVECT,[0],[0])
LAC 1,UNIVER↔SON Q,1↔ALT Q,Q↔ALT2 Q,Q ;SUN'S FRAME.
CW R,1↔DAD R,R↔ALT2 R,R ;CAMERA'S FRAME.
LAC XWC(Q)↔FMP XWC(Q)↔DAC 1
LAC YWC(Q)↔FMP YWC(Q)↔FAD 1,
LAC ZWC(Q)↔FMP ZWC(Q)↔FAD 1,↔CALL(SQRT,1)
LAC S,[350.0]↔FDVR S,1↔↔HRLZI IX(R)↔AOS↔BLT 9
FMP 7,XWC(Q)↔LAC 7↔FMP 8,YWC(Q)↔FAD 8↔FMP 9,ZWC(Q)↔FAD 9
FMP S↔FDVR [350.0]↔PUSH P,↔PUSH P,[2]
FMP 1,XWC(Q)↔LAC 1↔FMP 2,YWC(Q)↔FAD 2↔FMP 3,ZWC(Q)↔FAD 3↔FMP S↔FIXX↔PUSH P,
FMP 4,XWC(Q)↔LAC 4↔FMP 5,YWC(Q)↔FAD 5↔FMP 6,ZWC(Q)↔FAD 6↔FMP S↔FIXX↔PUSH P,
CALL(AVECT)↔CALL(DPYSTR,[[ASCIZ/SUN /]])↔CALL(FLODPY)↔GO .+1]
BEND
;----- STADPY DISPLAY THE SCRATCH PAD PDL.
;DISPLAY THE SCRATCH PAD PDL.
CALL(AIVECT,[-=511],[=430])
CDR 16,PDLPTR
CAILE 16,PDLPTR+=30 ;DISPLAY TOP THIRTY ITEMS.
MOVEI 16,PDLPTR+=30
CAILE 16,PADPDL↔GO[
CALL(IDPY,{(16)})
CALL(NTYPE,{(16)})
CAIG 1,$BODY↔GO NOTFEV
CALL(DPYSTR,[[ASCIZ/ of /]]) ;BODY OF WHICH.
CALL(BGET,{(16)})
CALL(IDPY,1)
NOTFEV: CALL(DTYO,[15])↔CALL(DTYO,[12])
SOJA 16,.-1]
;DISPLAY TOP OBJECT OF PADPDL.
CDR 1,PDLPTR↔CAILE 1,PADPDL
GO[CALL(QDPY,{(1)})↔GO .+1]
;DISPLAY THE SECOND OBJECT WHEN APPROPRIATE.
CDR 16,PDLPTR↔CAILE 16,PADPDL+1
GO[ LAC 1,-1(16)↔LAC 2,(16)
LAC 0,(1)↔IOR 0,(2)↔LDB[POINT 3,0,16]
CAIE 6↔CAIN 3↔SKIPA↔GO .+1
CALL(LINKED,1,2)↔JUMPE 1,.+1
CALL(QDPY,{-1(16)})
GO .+1]
L3: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔GO L4↔LAC 1,(1)
SKIPE FLAGD↔GO[CALL(DPYNODE,1)↔GO L4]
L4: SKIPE FLAGLF↔CALL(DPYFRM)
L5: CALL(DPYOUT↑,[0])
POP0J
ENDR STADPY;2-FEB-73(BGB)
SUBR(NTYPE,NODE) ;FETCH NODE TYPE NUMBER 0 TO 17.
COMMENT .-----------------------------------------------------------.
LAC 1,@NODE ;TYPE BITS WORD.
SKIPGE 1↔SETZ 1, ;NEGATIVE BIT.
TLNE 1,(1B9)↔SETZ 1, ;NORMALIZATION BIT.
ANDI 1,17↔POP1J
ENDR NTYPE;3/25/73(BGB)----------------------------------------------
SUBR(QDPY,OBJECT) ;SPECIAL ENTITY DISPLAY.
COMMENT .-----------------------------------------------------------.
CALL(NTYPE,OBJECT)
SETZ
CAIN 1,$BODY↔MOVEI BDPY
SKIPN FLAGL↔POP1J
CAIN 1,$FACE↔MOVEI FDPY
CAIN 1,$EDGE↔MOVEI EDPY
CAIN 1,$VERT↔MOVEI VDPY
JUMPE 0,POP1J.
CALL({@0},OBJECT)
POP1J
ENDR QDPY;-----------------------------------------------------------
;TABLES REL,CONTYP,NNAMES,NLETTER ;Node Info. Tables
;NODE RELLOCATION BITS.
; 0 1 2| 3 4 5| 6 7 8| 9 10 11|12 13 14|15 16 17| ← BIT.
; | 8 7 6| 5 4 3| 2 1 0|-1 -2 -3| ← WORD.
REL↑:
BEGIN REL
L8←←<(4000)>↔ R8←←4000 ↔ L7←←<(2000)>↔ R7←←2000
L6←←<(1000)>↔ R6←←1000 ↔ L5←←<(400)>↔ R5←← 400
L4←←<(200)>↔ R4←← 200 ↔ L3←←<(100)>↔ R3←← 100
L2←← <(40)>↔ R2←← 40 ↔ L1←← <(20)>↔ R1←← 20
NL1←← <(4)>↔NR1←← 4 ↔ NL2←← <(2)>↔NR2←← 2
NL3←← <(1)>↔NR3←← 1
0 ↔ R1 ;FRAME & EMPTY.
L7+R7+L4+R4+R1 ;UNIVERSE.
L6+R5+L5 ;LAMP.
L7+R7 + R6 + L5+R5 +R4 ;CAMERA.
L7+R7 + L6+R6 + L5+R5 + L4+R4 ;WORLD.
L7+R7 + L5+R5 + L4 ;WINDOW.
L7+R7 + L6+R6 + L5+R5 + L4+R4 ;IMAGE.
XWD 0004, 0004 ;TEXT.
0↔0↔0 ;X,Y,Z NODES.
XWD 3760, 3760 ;BODY.
XWD 1020, 1060 ;FACE.
XWD 3760, 3760 ;EDGE.
XWD 0140, 0140 ;VERTEX.
BEND
NLETTER↑: ;NODE INITIALS.
"R" ↔ "M" ↔ "U" ↔ "S"
"C" ↔ "W" ↔ "D" ↔ "I"
"T" ↔ "X" ↔ "Y" ↔ "Z"
"B" ↔ "F" ↔ "E" ↔ "V"
NNAMES↑: ;NODE NAMES
[ASCIZ"FRAME"]↔[ASCIZ"EMPTY"]↔[ASCIZ"UNIVERSE"]↔[ASCIZ"SUN"]
[ASCIZ"CAMERA"]↔[ASCIZ"WORLD"]↔[ASCIZ"WINDOW"]↔[ASCIZ"IMAGE"]
[ASCIZ"TEXT"]↔[ASCIZ"XNODE"]↔[ASCIZ"YNODE"]↔[ASCIZ"ZNODE"]
[ASCIZ"BODY"]↔[ASCIZ"FACE"]↔[ASCIZ"EDGE"]↔[ASCIZ"VERTEX"]
SUBN(JDPY,NODE) ;DISPLAY NODE'S NUMERAL.
SKIPN 1,NODE↔GO[
CALL(DPYSTR,{[[ASCIZ/NIL/]]})↔POP1J]
CAMGE 1,UNIVERSE↔GO L
CAML 1,JOBREL↑↔GO L
CALL(NTYPE,1)
CALL(DTYO,{NLETTER(1)})
L: CALL({OCTDPY},NODE)
POP1J
ENDR JDPY;3/25/73(BGB)-----------------------------------------------
;NODE CONTENT TYPES.
COMMENT ⊗
0 -- EMPTY.
1 -- OCTAL WORD.
2 -- ASCII.
3 -- REAL.
4 -- NODE.
| 8 7 6| 5 4 3| 2 1 0|-1 -2 -3| ← WORD.
⊗
CONTYP:
BYTE(9)333,333,333,333 ;FRAME.
BYTE(9)000,000,000,000 ;EMPTY.
BYTE(9)040,040,001,000 ;UNIVERSE.
BYTE(9)000,400,001,000 ;SUN
BYTE(9)044,440,001,000 ;CAMERA.
BYTE(9)044,440,441,220 ;WORLD.
BYTE(9)040,440,001,300 ;WINDOW.
BYTE(9)044,440,001,000 ;IMAGE.
BYTE(9)000,000,001,000 ;TEXT.
0 ;XNODE.
0 ;YNODE.
0 ;ZNODE.
BYTE(9)044,444,441,220 ;BODY.
BYTE(9)004,113,041,333 ;FACE.
BYTE(9)044,444,441,000 ;EDGE.
BYTE(9)003,334,411,333 ;VERTEX.
SUBR(DPYNODE,NODE) ;DISPLAY NODE CONTENTS.
COMMENT .-----------------------------------------------------------.
EXTERN AIVECT,AVECT,DPYBIG
EXTERN DTYO,DPYSTR,FLODPY,DECDPY,OCTDPY
;BOX IN LOWER RIGHT HAND CORNER OF THE SCREEN
CALL(AIVECT,[=260],[-=70])
CALL(AVECT,[=260],[-=380])
CALL(AVECT,[=508],[-=380])
CALL(AVECT,[=508],[-=70])
CALL(AVECT,[=260],[-=70])
;DISPLAY NODE'S NUMERAL AND NAME IMMEDIATELY ABOVE THE BOX.
CALL(DPYBIG,[1])↔CALL(JDPY,NODE)
SKIPN NODE↔POP1J
CALL(DPYSTR,{[[ASCIZ" "]]})
SETQ(KIND,{NTYPE,NODE})
LAC [POINT 7,LNKCHR]↔DAC LNKPTR
LAC REL(1)↔DAC RELTMP ;RELLOCATION.
LAC CONTYP(1)↔DAC CONTMP ;CONTENT TYPE.
LAC NNAMES(1)↔CALL(DPYSTR,0)
SKIPE FLAGD2↔GO L0
;FORMAT-2 DISPLAY GEOMETRIC DATA OF BODY,CAMERA OR SUN.
LAC 1,NODE↔LAC KIND
CAIN $BODY↔GO L3↔CAIN $SUN↔GO L3↔CAIN $CAMERA↔GO L3↔GO L0
L3: FRAME 1,1↔JUMPE 1,L0↔DAC 1,FRM
MOVSI -3(1)↔HRRI X↔BLT Z
;COMPUTE PAN, TILT AND SWING OF THE FRAME.
DEFINE DEGREE{FMPR 1,[57.29578]↔FAD 1,[0.001]↔FIXX 1,}
CALL(ACOS↑,{KZ(1)})
DAC 1,0↔DEGREE↔DAC 1,TILT ;TILT ← ACOS(KZ)
CALL(SIN↑,0)↔LAC 2,FRM ;TMP ← SIN(TILT)
SETZM SWING↔SETZM PAN
CAMGE 1,[0.0001]↔GO[ ;TILT TOO SMALL SWING.
CALL(ATAN2,{IY(2)},{IX(2)})
DEGREE↔DAC 1,PAN↔GO L4]
LAC [1.0]↔FDVR 1↔DAC 1 ;RECIPROCAL
LAC KX(2)↔FMPR 1↔PUSH P,
LAC KY(2)↔FMPR 1↔MOVN↔PUSH P,
LAC JZ(2)↔FMPR 1↔PUSH P,
CALL(ACOS)↔DEGREE↔DAC 1,SWING ;SWING ← ACOS(JZ/TMP)
CALL(ATAN2)↔DEGREE↔DAC 1,PAN ;PAN ← ATAN2(KX/TMP,-KY/TMP)
;COMPUTE AZIMUTH, ALTITUDE AND RANGE WITH RESPECT TO WORLD FRAME.
L4: CALL(ATAN2↑,Y,X)↔DEGREE↔DAC 1,AZM ;AZIMUTH.
LAC 1,X↔FMP 1,1↔LAC 2,Y↔FMP 2,2↔FADR 1,2↔PUSH P,1
CALL(SQRT↑,1)↔CALL(ATAN2,Z,1)↔DEGREE↔DAC 1,ALTI ;ALTITUDE.
POP P,1↔LAC 2,Z↔FMP 2,2↔FADR 1,2↔CALL(SQRT,1)↔DAC 1,RNG ;RANGE.
CALL(DPYBIG,[2])↔DELL←←=30
CALL(AIVECT,XDPY,[-=100])
CALL(DPYSTR,[[ASCIZ/XWC /]])↔CALL(FLODPY,X,[4])
CALL(AIVECT,XDPY,[-=100-DELL])
CALL(DPYSTR,[[ASCIZ/YWC /]])↔CALL(FLODPY,Y,[4])
CALL(AIVECT,XDPY,[-=100-2*DELL])
CALL(DPYSTR,[[ASCIZ/ZWC /]])↔CALL(FLODPY,Z,[4])
CALL(AIVECT,XDPY,[-=115-3*DELL])
CALL(DPYSTR,[[ASCIZ/ PAN /]])↔CALL(DECDPY,PAN)
CALL(AIVECT,XDPY,[-=115-4*DELL])
CALL(DPYSTR,[[ASCIZ/ TILT /]])↔CALL(DECDPY,TILT)
CALL(AIVECT,XDPY,[-=115-5*DELL])
CALL(DPYSTR,[[ASCIZ/SWING /]])↔CALL(DECDPY,SWING)
CALL(AIVECT,XDPY,[-=130-6*DELL])
CALL(DPYSTR,[[ASCIZ/RNG /]])↔CALL(FLODPY,RNG,[4])
CALL(AIVECT,XDPY,[-=130-7*DELL])
CALL(DPYSTR,[[ASCIZ/AZM /]])↔CALL(DECDPY,AZM)
CALL(AIVECT,XDPY,[-=130-8*DELL])
CALL(DPYSTR,[[ASCIZ/ALT /]])↔CALL(DECDPY,ALTI)
DEFINE MM{3.280833E-3}↔DEFINE MICRON{3.280833E-6}
LAC KIND↔CAIE $CAMERA↔GO L5↔LAC 1,NODE
LAC 1(1)↔FDVR[MICRON]↔DAC X
LAC 2(1)↔FDVR[MICRON]↔DAC Y
LAC 3(1)↔FDVR[MM]↔DAC Z
MOVEI =275↔DAC XDPY
CALL(AIVECT,XDPY,[-=145-=9*DELL])
CALL(DPYSTR,[[ASCIZ/ PDX /]])↔CALL(FLODPY,X,[2])↔CALL(DPYSTR,[[ASCIZ/ MICRONS/]])
CALL(AIVECT,XDPY,[-=145-=10*DELL])
CALL(DPYSTR,[[ASCIZ/ PDY /]])↔CALL(FLODPY,Y,[2])↔CALL(DPYSTR,[[ASCIZ/ MICRONS/]])
CALL(AIVECT,XDPY,[-=145-=11*DELL])
CALL(DPYSTR,[[ASCIZ/FOCAL /]])↔CALL(FLODPY,Z,[2])↔CALL(DPYSTR,[[ASCIZ/ MM/]])
MOVEI =300↔DAC XDPY
L5: CALL(DPYBIG,[2])↔CALL(AIVECT,[0],[0])↔POP1J
XDPY: =300
DECLARE{RNG,AZM,ALTI,PAN,TILT,SWING}
;FORMAT-1 DISPLAY FULL CONTENTS OF NODE: WORD -3 THRU WORD +8.
L0: HRREI -3↔DAC WRD
L1: MOVN WRD↔IMULI =25↔SUBI =170↔DAC Y
CALL(AIVECT,[=265],Y)
ILDB 1,LNKPTR ;PICK UP LINK CHARACTERS (LEFT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BETWEEN THEM
ILDB 1,LNKPTR ;(RIGHT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BEFORE A NUMBER
SKIPGE WRD↔GO .+3
CALL(DTYO,[" "]) ;AND ANOTHER IF NOT NEGATIVE
CALL(DECDPY,WRD)
;FULL WORD.
CALL(AIVECT,[=345],Y)
MOVN 2,WRD↔LAC CONTMP
ROT(2)↔ROT(2)↔ROT(2)↔ANDI 7000
CAIN 3000↔GO[LAC 1,NODE↔ADD 1,WRD
CALL(FLODPY,{(1)},[4])↔GO L2]
;LEFT HALF.
CALL(AIVECT,[=345],Y)
LAC 1,NODE↔ADD 1,WRD↔CAR(1)↔PUSH P,0
MOVN 2,WRD↔CAR RELTMP↔ROT(2)
TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY})
;RIGHT HALF.
CALL(AIVECT,[=425],Y)
LAC 1,NODE↔ADD 1,WRD↔CDR(1)↔PUSH P,0
MOVN 2,WRD↔CDR RELTMP↔ROT(2)
TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY})
L2: AOS 1,WRD↔CAIG 1,8↔GO L1
CALL(DPYBIG,[2])
CALL(AIVECT,[0],[0])
POP1J
LNKCHR: ASCIZ/ <>≤≥∨∧∩∪⊂⊃←→,./
DECLARE{WRD,X,Y,Z,KIND,RELTMP,CONTMP,LNKPTR,FRM}
ENDR DPYNODE;3/25/73(BGB)--------------------------------------------
SUBN(BDPY,BODY)
SKIPN FLAGLB↔POP1J↔LAC 1,BODY ;BODY LIGHTS ENABLED.
SETZ 0,
L1: PVT 1,1↔CAME 1,BODY↔AOJA 0,L1
IDIVI 0,=50↔DAC CNT#↔LAC 1,BODY
L2: PVT 1,1↔CAMN 1,BODY↔POP1J
SOJGE 0,L2↔CALL(VDPY,1)
LAC 1,1(P)↔LAC CNT↔GO L2
ENDR BDPY;-----------------------------------------------------------
VERNX←←14 ↔ VERNY←←11 ;III DISPLAY CHARACTER OFFSET.
SUBN(VDPY,VERTEX) ;SPECIAL VERTEX DISPLAY.
COMMENT .-----------------------------------------------------------.
LAC 1,VERTEX
TESTZ 1,NSEW+PZZ↔POP1J
XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
CALL(DPYBIG↑,[1])↔CALL(IDPY,VERTEX)
CALL(DPYBIG↑,[2])↔CALL(DPYBRT,[2])
CALL(AIVECT,[0],[0]) ;FORCE FINAL DPYBRT.
POP1J
ENDR VDPY;9-JAN-73(BGB)9-FEB-73(BGB)
SUBN(EDPY,EDGE) ;SPECIAL EDGE DISPLAY.
COMMENT .-----------------------------------------------------------.
CALL(DPYBIG↑,[1])↔CALL(DPYBRT,[4])
LAC 2,EDGE↔PVT 1,2
TESTZ 1,NSEW!PZZ↔GO L1
XDC 0,1↔FIXX↔DAC X
YDC 0,1↔FIXX↔DAC Y↔CALL(AIVECT,X,Y)
CALL(DTYO,["+"])↔ CALL(AIVECT,X,Y)
L1: LAC 2,EDGE↔NVT 1,2
TESTZ 1,NSEW!PZZ↔GO L2
XDC 0,1↔FIXX↔ADDM X↔PUSH P,
YDC 0,1↔FIXX↔ADDM Y↔PUSH P,↔CALL(AVECT)
CALL(DTYO,["-"])
L2: LAC 2,EDGE
LAC X↔ASH -1↔PUSH P,
LAC Y↔ASH -1↔PUSH P,↔CALL(AIVECT)
CALL(IDPY,EDGE)
CALL(DPYBIG,[2])
CALL(DPYBRT↑,[2])
CALL(AIVECT,[0],[0]) ;FORCE FINAL DPYBRT.
POP1J
DECLARE{X,Y}
ENDR EDPY;9-FEB-73(BGB)
SUBN(FDPY,FACE) ;SPECIAL FACE DISPLAY.
COMMENT .-----------------------------------------------------------.
LAC 1,FACE↔DAC 1,F↔TEST 1,FBIT↔POP1J
PED 2,1↔DAC 2,E↔DAC 2,E0↔JUMPE 2,POP1J.
SETZM I
CALL(DPYBIG,[1])
CALL(DPYBRT↑,[3])
SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
L1: AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
X1DC 0,2↔DAC 0,X
Y1DC 1,2↔DAC 1,Y
CALL(AIVECT,0,1)↔LAC 2,E
X2DC 0,2↔ADDM 0,X
Y2DC 1,2↔ADDM 1,Y
CALL(AVECT,0,1)
LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
CALL(AIVECT,0,1)
CALL(DECDPY,I)
L2: CALL(ECCW,E,F)
CAMN 1,E↔GO L3↔DAC 1,E
CAME 1,E0↔GO L1
L3: CALL(DPYBRT↑,[2])
CALL(DPYBIG,[2])
CALL(AIVECT,[0],[0]) ;FORCE FINAL DPYBRT.
POP1J
DECLARE{F,E,E0,X,Y,I}
ENDR FDPY;9-FEB-73(BGB)
SUBR(IDPY,NODE) ;IDENTIFIER DISPLAY.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,Q,M,N,Q1}
SKIPN Q,NODE↔GO[CALL(DPYSTR,{[[ASCIZ/NIL/]]})↔POP1J]
SETQ(N,{NTYPE,NODE})
CAIGE N,$BODY↔GO L3
CAIE N,$BODY↔GO L2
;BODY'S NUMERAL.
MOVEI M,1↔LAC B,Q
L1: CW Q,Q↔TESTZ Q,BBIT↔AOJA M,L1 ;COUNT SERIAL NUMBER.
PUSH P,Q ;SAVE WORLD OF BODY.
SKIPE 13,-2(B)↔GO[
LAC 14,-1(B)↔SETZM 15
CALL(DPYSTR,[13])↔GO L1A] ;DISPLAY BODY PNAME.
PUSH P,M↔CALL(DTYO,["B"])↔CALL(DECDPY) ;DISPLAY BODY NUMERAL.
L1A: POP P,Q ;RETRIEVE WORLD OF BODY.
LAC 1,UNIVER↔NWRLD 1,1↔CAMN 1,Q↔POP1J ;EXIT IF B IN NOW WORLD.
PUSH P,Q↔CALL(DPYSTR,[[ASCIZ/ of /]]) ;DISPLAY B'S WORLD.
CALL(IDPY)↔POP1J
;FACE-EDGE-VERTEX.
L2: SUBI N,15 ;TYPE: 0-FACE, 1-EDGE, 2-VERTEX.
SETQ(B,{BGET,NODE})
LAC Q,NODE↔MOVEI M,1 ;COUNT UP TO FEV SERIAL NUMBER.
XCT[NFACE Q,Q↔NED Q,Q↔NVT Q,Q](N)
CAME Q,B↔AOJA M,.-2
PUSH P,M ;SERIAL NUMBER.
PUSH P,["F"↔"E"↔"V"](N) ;INITIAL.
CALL(DTYO) ;INITIAL.
CALL(DECDPY) ;SERIAL NUMBER.
POP1J
L3: PUSH P,N↔CALL(DPYSTR,{NNAMES(N)})↔POP P,N
LAC Q,NODE
CAIG N,2↔POP1J ;EXIT: FRAME,EMPTY,UNIVERSE.
CAIL N,10↔POP1J ;EXIT: TEXT,X,Y,Z NODE.
;PICKUP THE OWNER AND THE FIRST MEMBER OF A SUN, CAMERA OR WORLD RING.
SUBI N,3
;NODE:;SUN ;CAMERA ;WORLD ;WINDOW ;IMAGE
XCT[PWRLD B,Q↔ PWRLD B,Q↔ LAC B,UNIVER↔ NCAMR B,Q↔ NCAMR B,Q](N)
XCT[ALT Q1,B↔ PCAMR Q1,B↔ PWRLD Q1,B↔ PVT M,Q↔ PVT M,Q](N)
CAIL N,3↔GO L4 ;WINDOW'S AND IMAGES DON'T HAVE SERIAL RINGS.
;ACCUMULATE SERIAL NUMBER.
SKIPA M,[1]↔BRO Q,Q
CAME Q,Q1↔AOJA M,.-2
CAIN N,2↔GO L5 ;SUPRESS "WORLD OF UNIVERSE" CASE.
;DISPLAY SERIAL NUMBER-M AND IDENTITY OF OWNER.
L4: PUSH P,B ;OWNER OF Q.
CALL(DECDPY,M) ;SERIAL NUMERAL OF Q.
CALL(DPYSTR,[[ASCIZ/ of /]])
CALL(IDPY)↔POP1J
L5: CALL(DECDPY,M)↔POP1J ;SERIAL NUMERAL OF Q.
ENDR IDPY;2/4/73(BGB)------------------------------------------------
IFE SAIL{END SA}
IFN SAIL{END}
GEOMED.FAI - EOF.